[flang] Revert recent addition of ActualArgument::PassedObject

reformatting

Complete merging with current master

implement extension of inherited type-bound generics

Original-commit: flang-compiler/f18@e58c4e53c2
Reviewed-on: https://github.com/flang-compiler/f18/pull/864
This commit is contained in:
peter klausler 2019-12-09 13:52:12 -08:00
parent a27ed74672
commit e693198c5c
6 changed files with 110 additions and 80 deletions

View file

@ -60,7 +60,8 @@ int ActualArgument::Rank() const {
bool ActualArgument::operator==(const ActualArgument &that) const {
return keyword_ == that.keyword_ &&
isAlternateReturn_ == that.isAlternateReturn_ && u_ == that.u_;
isAlternateReturn_ == that.isAlternateReturn_ &&
isPassedObject_ == that.isPassedObject_ && u_ == that.u_;
}
void ActualArgument::Parenthesize() {

View file

@ -72,17 +72,9 @@ public:
SymbolRef symbol_;
};
// A placeholder for the passed-object argument, which will be replaced
// with the base object of the Component that constitutes the call's
// ProcedureDesignator.
struct PassedObject {
bool operator==(const PassedObject &) const { return true; }
};
explicit ActualArgument(Expr<SomeType> &&);
explicit ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&);
explicit ActualArgument(AssumedType);
explicit ActualArgument(PassedObject &&) : u_{PassedObject{}} {}
~ActualArgument();
ActualArgument &operator=(Expr<SomeType> &&);
@ -120,10 +112,9 @@ public:
void set_keyword(parser::CharBlock x) { keyword_ = x; }
bool isAlternateReturn() const { return isAlternateReturn_; }
void set_isAlternateReturn() { isAlternateReturn_ = true; }
bool isPassedObject() const { return isPassedObject_; }
void set_isPassedObject(bool yes = true) { isPassedObject_ = yes; }
bool IsPassedObject() const {
return std::holds_alternative<PassedObject>(u_);
}
bool Matches(const characteristics::DummyArgument &) const;
// Wrap this argument in parentheses
@ -137,11 +128,10 @@ private:
// e.g. between X and (X). The parser attempts to parse each argument
// first as a variable, then as an expression, and the distinction appears
// in the parse tree.
std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType,
PassedObject>
u_;
std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType> u_;
std::optional<parser::CharBlock> keyword_;
bool isAlternateReturn_{false}; // whether expr is a "*label" number
bool isPassedObject_{false};
};
using ActualArguments = std::vector<std::optional<ActualArgument>>;
@ -172,7 +162,11 @@ struct ProcedureDesignator {
const SpecificIntrinsic *GetSpecificIntrinsic() const;
const Symbol *GetSymbol() const; // symbol or component symbol
// Always null if the procedure is intrinsic.
// For references to NOPASS components and bindings only.
// References to PASS components and bindings are represented
// with the symbol below and the base object DataRef in the
// passed-object ActualArgument.
// Always null when the procedure is intrinsic.
const Component *GetComponent() const;
const Symbol *GetInterfaceSymbol() const;

View file

@ -109,7 +109,6 @@ std::ostream &ActualArgument::AssumedType::AsFortran(std::ostream &o) const {
}
std::ostream &ActualArgument::AsFortran(std::ostream &o) const {
CHECK(!IsPassedObject());
if (keyword_) {
o << keyword_->ToString() << '=';
}
@ -128,10 +127,16 @@ std::ostream &SpecificIntrinsic::AsFortran(std::ostream &o) const {
}
std::ostream &ProcedureRef::AsFortran(std::ostream &o) const {
for (const auto &arg : arguments_) {
if (arg && arg->isPassedObject()) {
arg->AsFortran(o) << '%';
break;
}
}
proc_.AsFortran(o);
char separator{'('};
for (const auto &arg : arguments_) {
if (arg && !arg->IsPassedObject()) {
if (arg && !arg->isPassedObject()) {
arg->AsFortran(o << separator);
separator = ',';
}

View file

@ -565,16 +565,11 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
messages.Say(
"Actual argument is not a variable or typed expression"_err_en_US);
}
} else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
// An assumed-type dummy is being forwarded.
if (!object.type.type().IsAssumedType()) {
messages.Say(
"Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) %s"_err_en_US,
assumed->name(), dummyName);
}
} else if (!arg.IsPassedObject()) {
} else if (!object.type.type().IsAssumedType()) {
const Symbol &assumed{DEREF(arg.GetAssumedTypeDummy())};
messages.Say(
"Actual argument is not an expression or variable"_err_en_US);
"Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) %s"_err_en_US,
assumed.name(), dummyName);
}
},
[&](const characteristics::DummyProcedure &proc) {

View file

@ -31,7 +31,7 @@
#include <optional>
#include <set>
#define CRASH_ON_FAILURE 1
// #define CRASH_ON_FAILURE 1
// #define DUMP_ON_FAILURE 1
#if DUMP_ON_FAILURE
#include "../parser/dump-parse-tree.h"
@ -1553,15 +1553,17 @@ static int GetPassIndex(const semantics::Symbol &proc, parser::CharBlock name) {
return 0; // first argument is passed-object
}
// Given a call `base%component(actuals)`, create a copy of actuals that
// includes a place-holder for the passed-object argument, if any.
// Return the index of that argument, or nullopt if there isn't one.
static std::optional<int> AddPassArg(
const Symbol &component, ActualArguments &actuals) {
// Injects an expression into an actual argument list as the "passed object"
// for a type-bound procedure reference that is not NOPASS. Adds an
// argument keyword if possible, but not when the passed object goes
// before a positional argument.
// e.g., obj%tbp(x) -> tbp(obj,x).
static void AddPassArg(ActualArguments &actuals, Expr<SomeDerived> &&expr,
const Symbol &component, bool isPassedObject = true) {
if (component.attrs().test(semantics::Attr::NOPASS)) {
return std::nullopt;
return;
}
std::optional<parser::CharBlock> passName{GetPassName(component)};
auto passName{GetPassName(component)};
int passIndex{passName ? GetPassIndex(component, *passName) : 0};
auto iter{actuals.begin()};
int at{0};
@ -1573,12 +1575,12 @@ static std::optional<int> AddPassArg(
++iter;
++at;
}
ActualArgument passed{ActualArgument::PassedObject{}};
ActualArgument passed{AsGenericExpr(std::move(expr))};
passed.set_isPassedObject(isPassedObject);
if (iter == actuals.end() && passName) {
passed.set_keyword(*passName);
}
actuals.emplace(iter, std::move(passed));
return passIndex;
}
auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
@ -1589,54 +1591,44 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
if (MaybeExpr base{Analyze(sc.base)}) {
if (const Symbol * sym{sc.component.symbol}) {
if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
const semantics::DerivedTypeSpec *dtSpec{nullptr};
const auto *binding{sym->detailsIf<semantics::ProcBindingDetails>()};
if (sym->has<semantics::GenericDetails>()) {
sym = ResolveGeneric(*sym, arguments, *dtExpr);
if (!sym) {
return std::nullopt;
}
}
const Symbol *resolution{nullptr};
if (binding && sym->attrs().test(semantics::Attr::NON_OVERRIDABLE)) {
resolution = &binding->symbol();
}
if (std::optional<DynamicType> dtDyTy{dtExpr->GetType()}) {
if (!dtDyTy->IsUnlimitedPolymorphic()) {
dtSpec = &dtDyTy->GetDerivedTypeSpec();
}
if (binding && !dtDyTy->IsPolymorphic()) {
if (const auto *binding{
sym->detailsIf<semantics::ProcBindingDetails>()}) {
if (sym->attrs().test(semantics::Attr::NON_OVERRIDABLE)) {
resolution = &binding->symbol();
} else if (std::optional<DynamicType> dtDyTy{dtExpr->GetType()}) {
if (!dtDyTy->IsPolymorphic()) {
resolution = &binding->symbol();
}
}
}
if (dtSpec && dtSpec->scope()) {
if (sym->has<semantics::GenericDetails>()) {
sym = ResolveGeneric(*sym, arguments, *dtExpr);
if (!sym) {
return std::nullopt;
}
}
if (std::optional<DataRef> dataRef{
ExtractDataRef(std::move(*dtExpr))}) {
if (std::optional<Component> component{CreateComponent(
std::move(*dataRef), *sym, *dtSpec->scope())}) {
if (std::optional<int> passIndex{AddPassArg(*sym, arguments)}) {
if (resolution) {
arguments[*passIndex] = AsGenericExpr(std::move(*dtExpr));
}
}
return CalleeAndArguments{resolution
? ProcedureDesignator{*resolution}
: ProcedureDesignator{std::move(*component)},
std::move(arguments)};
} else {
Say(name,
"Procedure component is not in scope of derived TYPE(%s)"_err_en_US,
dtSpec->typeSymbol().name());
}
if (resolution) {
AddPassArg(arguments, std::move(*dtExpr), *sym, false);
return CalleeAndArguments{
ProcedureDesignator{*resolution}, std::move(arguments)};
} else if (std::optional<DataRef> dataRef{
ExtractDataRef(std::move(*dtExpr))}) {
if (sym->attrs().test(semantics::Attr::NOPASS)) {
return CalleeAndArguments{
ProcedureDesignator{Component{std::move(*dataRef), *sym}},
std::move(arguments)};
} else {
Say(name,
"Base of procedure component reference must be a data reference"_err_en_US);
AddPassArg(arguments,
Expr<SomeDerived>{Designator<SomeDerived>{std::move(*dataRef)}},
*sym);
return CalleeAndArguments{
ProcedureDesignator{*sym}, std::move(arguments)};
}
}
} else {
Say(name,
"Base of procedure component reference is not a derived type object"_err_en_US);
}
Say(name,
"Base of procedure component reference is not a derived-type object"_err_en_US);
}
}
CHECK(!GetContextualMessages().empty());
@ -1699,9 +1691,7 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
ProcedureDesignator{specific}, context_.intrinsics())}) {
ActualArguments localActuals{actuals};
if (specific.has<semantics::ProcBindingDetails>()) {
if (std::optional<int> passIndex{AddPassArg(specific, localActuals)}) {
localActuals[*passIndex] = AsGenericExpr(common::Clone(base.value()));
}
AddPassArg(localActuals, common::Clone(base.value()), specific);
}
if (semantics::CheckInterfaceForGeneric(
*procedure, localActuals, GetFoldingContext())) {
@ -1717,6 +1707,14 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
if (elemental) {
return elemental;
}
// Check parent derived type
if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
if (extended->GetUltimate().has<semantics::GenericDetails>()) {
return ResolveGeneric(*extended, actuals, base);
}
}
}
if (semantics::IsGenericDefinedOp(symbol)) {
Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
symbol.name());

View file

@ -34,19 +34,36 @@ contains
type(t) :: x, y
real :: z(x%add1(y))
end
subroutine test1p(x, y, z)
class(t) :: x, y
real :: z(x%add1(y))
end
subroutine test2(x, y, z)
type(t) :: x, y
real :: z(x%g(y))
end
subroutine test2p(x, y, z)
class(t) :: x, y
real :: z(x%g(y))
end
subroutine test3(x, y, z)
type(t) :: x, y
real :: z(x%g(y, x))
end
subroutine test3p(x, y, z)
class(t) :: x, y
real :: z(x%g(y, x))
end
subroutine test4(x, y, z)
type(t) :: x
real :: y
real :: z(x%g(y))
end
subroutine test4p(x, y, z)
class(t) :: x
real :: y
real :: z(x%g(y))
end
end
!Expect: m1.mod
@ -76,19 +93,39 @@ end
! type(t) :: y
! real(4) :: z(1_8:add(x, y))
! end
! subroutine test1p(x,y,z)
! class(t)::x
! class(t)::y
! real(4)::z(1_8:x%add1(y))
! end
! subroutine test2(x, y, z)
! type(t) :: x
! type(t) :: y
! real(4)::z(1_8:add(x,y))
! end
! subroutine test2p(x,y,z)
! class(t)::x
! class(t)::y
! real(4) :: z(1_8:x%add1(y))
! end
! subroutine test3(x, y, z)
! type(t) :: x
! type(t) :: y
! real(4)::z(1_8:add(y,x))
! end
! subroutine test3p(x,y,z)
! class(t)::x
! class(t)::y
! real(4) :: z(1_8:x%add2(y, x))
! end
! subroutine test4(x, y, z)
! type(t) :: x
! real(4) :: y
! real(4)::z(1_8:add_real(x,y))
! end
! subroutine test4p(x,y,z)
! class(t)::x
! real(4)::y
! real(4) :: z(1_8:x%add_real(y))
! end
!end