forked from OSchip/llvm-project
[flang] Resolve defined operators to specifics
Most of these changes involve moving code around so that it case be used for `DefinedUnary` and `DefinedBinary`. The functional changes are in the `Analyze` member functions for those cases where the arguments are now analyzed, the generic is resolved, and a `FunctionRef` is created. Add `ArgumentAnalyzer` to handling building of the `ActualArguments` of a call. This allows the code to be shared with the defined unary and defined binary cases. Move `AnalyzeActualArgument` and `AnalyzeActualArgument` into that class (renaming both to `Analyze`). Create an overload of `GetCalleeAndArguments` for the `Name` case so it can be used for defined ops where we don't have a `ProcedureDesignator`. Move `IsGenericDefinedOp` to `tools.h` to make it available to the new code. We were using `semantics::CheckExplicitInterface` to resolve a generic interface to a specific procedure based on actual arguments. The problem with that is that it performs too many checks. We just want to get the right specific; there may be errors reported later during call analysis. To fix this, add a new function, `CheckInterfaceForGeneric`, to perform this check. It shares code with `CheckExplicitInterface`, but it passes in a null scope to indicate that the full set of checks aren't necessary in `CheckExplicitInterfaceArg`. Instead we lift the call to `TypeAndShape::IsCompatibleWith` out of `CheckExplicitDataArg`, and skip the latter when there is no scope. Original-commit: flang-compiler/f18@fff2d1580f Reviewed-on: https://github.com/flang-compiler/f18/pull/786
This commit is contained in:
Tim Keith
parent
2a7af74b3e
commit
373f7489ef
|
|
@ -102,19 +102,12 @@ static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
|
|||
|
||||
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
||||
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
|
||||
const characteristics::TypeAndShape &actualType,
|
||||
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
|
||||
const Scope &scope) {
|
||||
const characteristics::TypeAndShape &actualType, bool isElemental,
|
||||
evaluate::FoldingContext &context, const Scope &scope) {
|
||||
|
||||
// Basic type & rank checking
|
||||
parser::ContextualMessages &messages{context.messages()};
|
||||
int dummyRank{evaluate::GetRank(dummy.type.shape())};
|
||||
bool isElemental{dummyRank == 0 &&
|
||||
proc.attrs.test(characteristics::Procedure::Attr::Elemental)};
|
||||
PadShortCharacterActual(actual, dummy.type, actualType, messages);
|
||||
dummy.type.IsCompatibleWith(
|
||||
messages, actualType, "dummy argument", "actual argument", isElemental);
|
||||
|
||||
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
|
||||
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
|
||||
bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
|
||||
|
|
@ -235,7 +228,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
"Declaration of assumed-size array actual argument"_en_US);
|
||||
}
|
||||
}
|
||||
} else if (actualRank == 0 && dummyRank > 0) {
|
||||
} else if (actualRank == 0 && dummy.type.Rank() > 0) {
|
||||
// Actual is scalar, dummy is an array. 15.5.2.4(14), 15.5.2.11
|
||||
if (actualIsCoindexed) {
|
||||
messages.Say(
|
||||
|
|
@ -329,7 +322,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
|
||||
const characteristics::DummyArgument &dummy,
|
||||
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
|
||||
const Scope &scope) {
|
||||
const Scope *scope) {
|
||||
auto &messages{context.messages()};
|
||||
std::string dummyName{"dummy argument"};
|
||||
if (!dummy.name.empty()) {
|
||||
|
|
@ -341,8 +334,13 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
|
|||
if (auto *expr{arg.UnwrapExpr()}) {
|
||||
if (auto type{characteristics::TypeAndShape::Characterize(
|
||||
*expr, context)}) {
|
||||
CheckExplicitDataArg(
|
||||
object, dummyName, *expr, *type, proc, context, scope);
|
||||
bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
|
||||
object.type.IsCompatibleWith(context.messages(), *type,
|
||||
"dummy argument", "actual argument", isElemental);
|
||||
if (scope) {
|
||||
CheckExplicitDataArg(object, dummyName, *expr, *type,
|
||||
isElemental, context, *scope);
|
||||
}
|
||||
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
|
||||
std::holds_alternative<evaluate::BOZLiteralConstant>(
|
||||
expr->u)) {
|
||||
|
|
@ -424,9 +422,9 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
|
|||
}
|
||||
}
|
||||
|
||||
parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
|
||||
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
|
||||
const Scope &scope) {
|
||||
static parser::Messages CheckExplicitInterface(
|
||||
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
|
||||
const evaluate::FoldingContext &context, const Scope *scope) {
|
||||
parser::Messages buffer;
|
||||
parser::ContextualMessages messages{context.messages().at(), &buffer};
|
||||
evaluate::FoldingContext localContext{context, messages};
|
||||
|
|
@ -455,6 +453,18 @@ parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
|
|||
return buffer;
|
||||
}
|
||||
|
||||
parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
|
||||
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
|
||||
const Scope &scope) {
|
||||
return CheckExplicitInterface(proc, actuals, context, &scope);
|
||||
}
|
||||
|
||||
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
|
||||
evaluate::ActualArguments &actuals,
|
||||
const evaluate::FoldingContext &context) {
|
||||
return CheckExplicitInterface(proc, actuals, context, nullptr).empty();
|
||||
}
|
||||
|
||||
void CheckArguments(const characteristics::Procedure &proc,
|
||||
evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
|
||||
const Scope &scope, bool treatingExternalAsImplicit) {
|
||||
|
|
|
|||
|
|
@ -46,5 +46,8 @@ void CheckArguments(const evaluate::characteristics::Procedure &,
|
|||
parser::Messages CheckExplicitInterface(
|
||||
const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,
|
||||
const evaluate::FoldingContext &, const Scope &);
|
||||
// Check actual arguments for the purpose of resolving a generic interface.
|
||||
bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
|
||||
evaluate::ActualArguments &, const evaluate::FoldingContext &);
|
||||
}
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -133,6 +133,28 @@ common::IfNoLvalue<MaybeExpr, WRAPPED> TypedWrapper(
|
|||
}
|
||||
}
|
||||
|
||||
class ArgumentAnalyzer {
|
||||
public:
|
||||
explicit ArgumentAnalyzer(ExpressionAnalyzer &context) : context_{context} {}
|
||||
bool success() const { return success_; }
|
||||
ActualArguments &&GetActuals() {
|
||||
CHECK(success_);
|
||||
return std::move(actuals_);
|
||||
}
|
||||
template<typename T> void Analyze(const T &x) {
|
||||
actuals_.emplace_back(context_.Analyze(x));
|
||||
success_ &= actuals_.back().has_value();
|
||||
}
|
||||
void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
|
||||
|
||||
private:
|
||||
std::optional<ActualArgument> Analyze(const parser::Expr &);
|
||||
|
||||
ExpressionAnalyzer &context_;
|
||||
ActualArguments actuals_;
|
||||
bool success_{true};
|
||||
};
|
||||
|
||||
// Wraps a data reference in a typed Designator<>, and a procedure
|
||||
// or procedure pointer reference in a ProcedureDesignator.
|
||||
MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
|
||||
|
|
@ -1559,69 +1581,47 @@ static bool CheckCompatibleArguments(
|
|||
return true;
|
||||
}
|
||||
|
||||
const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
|
||||
ActualArguments &actuals, const semantics::Scope &scope) {
|
||||
const Symbol *ExpressionAnalyzer::ResolveGeneric(
|
||||
const Symbol &symbol, ActualArguments &actuals) {
|
||||
const Symbol *elemental{nullptr}; // matching elemental specific proc
|
||||
const auto &details{symbol.get<semantics::GenericDetails>()};
|
||||
const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
|
||||
for (const Symbol *specific : details.specificProcs()) {
|
||||
if (std::optional<characteristics::Procedure> procedure{
|
||||
characteristics::Procedure::Characterize(
|
||||
ProcedureDesignator{*specific}, context_.intrinsics())}) {
|
||||
ActualArguments localActuals{actuals};
|
||||
auto messages{semantics::CheckExplicitInterface(
|
||||
*procedure, localActuals, GetFoldingContext(), scope)};
|
||||
if (messages.empty() &&
|
||||
CheckCompatibleArguments(*procedure, localActuals)) {
|
||||
if (!procedure->IsElemental()) {
|
||||
return specific; // takes priority over elemental match
|
||||
if (semantics::CheckInterfaceForGeneric(
|
||||
*procedure, localActuals, GetFoldingContext())) {
|
||||
if (CheckCompatibleArguments(*procedure, localActuals)) {
|
||||
if (!procedure->IsElemental()) {
|
||||
return specific; // takes priority over elemental match
|
||||
}
|
||||
elemental = specific;
|
||||
}
|
||||
elemental = specific;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (elemental) {
|
||||
return elemental;
|
||||
}
|
||||
if (semantics::IsGenericDefinedOp(symbol)) {
|
||||
Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
|
||||
symbol.name());
|
||||
} else {
|
||||
Say("No specific procedure of generic '%s' matches the actual arguments"_err_en_US,
|
||||
symbol.name());
|
||||
return nullptr;
|
||||
}
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
auto ExpressionAnalyzer::GetCalleeAndArguments(
|
||||
const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
|
||||
bool isSubroutine, const semantics::Scope &scope)
|
||||
-> std::optional<CalleeAndArguments> {
|
||||
bool isSubroutine) -> std::optional<CalleeAndArguments> {
|
||||
return std::visit(
|
||||
common::visitors{
|
||||
[&](const parser::Name &n) -> std::optional<CalleeAndArguments> {
|
||||
const Symbol *symbol{n.symbol};
|
||||
if (context_.HasError(symbol)) {
|
||||
return std::nullopt;
|
||||
}
|
||||
const Symbol &ultimate{symbol->GetUltimate()};
|
||||
if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
|
||||
if (std::optional<SpecificCall> specificCall{
|
||||
context_.intrinsics().Probe(
|
||||
CallCharacteristics{n.source, isSubroutine},
|
||||
arguments, GetFoldingContext())}) {
|
||||
return CalleeAndArguments{ProcedureDesignator{std::move(
|
||||
specificCall->specificIntrinsic)},
|
||||
std::move(specificCall->arguments)};
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
}
|
||||
CheckForBadRecursion(n.source, ultimate);
|
||||
if (ultimate.has<semantics::GenericDetails>()) {
|
||||
symbol = ResolveGeneric(ultimate, arguments, scope);
|
||||
}
|
||||
if (symbol) {
|
||||
return CalleeAndArguments{
|
||||
ProcedureDesignator{*symbol}, std::move(arguments)};
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
[&](const parser::Name &name) {
|
||||
return GetCalleeAndArguments(
|
||||
name, std::move(arguments), isSubroutine);
|
||||
},
|
||||
[&](const parser::ProcComponentRef &pcr) {
|
||||
return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
|
||||
|
|
@ -1630,6 +1630,38 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
|
|||
pd.u);
|
||||
}
|
||||
|
||||
auto ExpressionAnalyzer::GetCalleeAndArguments(
|
||||
const parser::Name &name, ActualArguments &&arguments, bool isSubroutine)
|
||||
-> std::optional<CalleeAndArguments> {
|
||||
const Symbol *symbol{name.symbol};
|
||||
if (context_.HasError(symbol)) {
|
||||
return std::nullopt;
|
||||
}
|
||||
const Symbol &ultimate{symbol->GetUltimate()};
|
||||
if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
|
||||
if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
|
||||
CallCharacteristics{name.source, isSubroutine}, arguments,
|
||||
GetFoldingContext())}) {
|
||||
return CalleeAndArguments{
|
||||
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
|
||||
std::move(specificCall->arguments)};
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
} else {
|
||||
CheckForBadRecursion(name.source, ultimate);
|
||||
if (ultimate.has<semantics::GenericDetails>()) {
|
||||
symbol = ResolveGeneric(*symbol, arguments);
|
||||
}
|
||||
if (symbol) {
|
||||
return CalleeAndArguments{
|
||||
ProcedureDesignator{*symbol}, std::move(arguments)};
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void ExpressionAnalyzer::CheckForBadRecursion(
|
||||
parser::CharBlock callSite, const semantics::Symbol &proc) {
|
||||
if (const auto *scope{proc.scope()}) {
|
||||
|
|
@ -1669,41 +1701,6 @@ template<typename A> static const Symbol *AssumedTypeDummy(const A &x) {
|
|||
return nullptr;
|
||||
}
|
||||
|
||||
std::optional<ActualArgument> ExpressionAnalyzer::AnalyzeActualArgument(
|
||||
const parser::Expr &expr) {
|
||||
if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
|
||||
return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
|
||||
} else if (MaybeExpr argExpr{Analyze(expr)}) {
|
||||
Expr<SomeType> x{Fold(GetFoldingContext(), std::move(*argExpr))};
|
||||
if (const auto *proc{std::get_if<ProcedureDesignator>(&x.u)}) {
|
||||
if (!std::holds_alternative<SpecificIntrinsic>(proc->u) &&
|
||||
proc->IsElemental()) { // C1533
|
||||
Say(expr.source,
|
||||
"Non-intrinsic ELEMENTAL procedure cannot be passed as argument"_err_en_US);
|
||||
}
|
||||
}
|
||||
if (auto coarrayRef{ExtractCoarrayRef(x)}) {
|
||||
const Symbol &coarray{coarrayRef->GetLastSymbol()};
|
||||
if (const semantics::DeclTypeSpec * type{coarray.GetType()}) {
|
||||
if (const semantics::DerivedTypeSpec * derived{type->AsDerived()}) {
|
||||
if (auto ptr{semantics::FindPointerUltimateComponent(*derived)}) {
|
||||
if (auto *msg{Say(expr.source,
|
||||
"Coindexed object '%s' with POINTER ultimate component '%s' cannot be passed as argument"_err_en_US,
|
||||
coarray.name(), (*ptr)->name())}) {
|
||||
msg->Attach((*ptr)->name(),
|
||||
"Declaration of POINTER '%s' component of %s"_en_US,
|
||||
(*ptr)->name(), type->AsFortran());
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return ActualArgument{std::move(x)};
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
}
|
||||
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(
|
||||
const parser::FunctionReference &funcRef) {
|
||||
return AnalyzeCall(funcRef.v, false);
|
||||
|
|
@ -1716,12 +1713,15 @@ void ExpressionAnalyzer::Analyze(const parser::CallStmt &call) {
|
|||
MaybeExpr ExpressionAnalyzer::AnalyzeCall(
|
||||
const parser::Call &call, bool isSubroutine) {
|
||||
auto save{GetContextualMessages().SetLocation(call.source)};
|
||||
if (auto arguments{AnalyzeArguments(call, isSubroutine)}) {
|
||||
ArgumentAnalyzer analyzer{*this};
|
||||
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
|
||||
analyzer.Analyze(arg, isSubroutine);
|
||||
}
|
||||
if (analyzer.success()) {
|
||||
// TODO: map non-intrinsic generic procedure to specific procedure
|
||||
if (std::optional<CalleeAndArguments> callee{
|
||||
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
|
||||
std::move(*arguments), isSubroutine,
|
||||
context_.FindScope(call.source))}) {
|
||||
analyzer.GetActuals(), isSubroutine)}) {
|
||||
if (isSubroutine) {
|
||||
CheckCall(call.source, callee->procedureDesignator, callee->arguments);
|
||||
// TODO: Package the subroutine call as an expr in the parse tree
|
||||
|
|
@ -1735,50 +1735,6 @@ MaybeExpr ExpressionAnalyzer::AnalyzeCall(
|
|||
return std::nullopt;
|
||||
}
|
||||
|
||||
std::optional<ActualArguments> ExpressionAnalyzer::AnalyzeArguments(
|
||||
const parser::Call &call, bool isSubroutine) {
|
||||
evaluate::ActualArguments arguments;
|
||||
// TODO: C1002: Allow a whole assumed-size array to appear if the dummy
|
||||
// argument would accept it. Handle by special-casing the context
|
||||
// ActualArg -> Variable -> Designator.
|
||||
// TODO: Actual arguments that are procedures and procedure pointers need to
|
||||
// be detected and represented (they're not expressions).
|
||||
// TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
|
||||
// TODO: map non-intrinsic generic procedure to specific procedure
|
||||
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
|
||||
std::optional<evaluate::ActualArgument> actual;
|
||||
std::visit(
|
||||
common::visitors{
|
||||
[&](const common::Indirection<parser::Expr> &x) {
|
||||
// TODO: Distinguish & handle procedure name and
|
||||
// proc-component-ref
|
||||
actual = AnalyzeActualArgument(x.value());
|
||||
},
|
||||
[&](const parser::AltReturnSpec &) {
|
||||
if (!isSubroutine) {
|
||||
Say("alternate return specification may not appear on function reference"_err_en_US);
|
||||
}
|
||||
},
|
||||
[&](const parser::ActualArg::PercentRef &) {
|
||||
Say("TODO: %REF() argument"_err_en_US);
|
||||
},
|
||||
[&](const parser::ActualArg::PercentVal &) {
|
||||
Say("TODO: %VAL() argument"_err_en_US);
|
||||
},
|
||||
},
|
||||
std::get<parser::ActualArg>(arg.t).u);
|
||||
if (actual.has_value()) {
|
||||
arguments.emplace_back(std::move(actual));
|
||||
if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
|
||||
arguments.back()->keyword = argKW->v.source;
|
||||
}
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
}
|
||||
return arguments;
|
||||
}
|
||||
|
||||
static bool IsExternalCalledImplicitly(
|
||||
parser::CharBlock callSite, const ProcedureDesignator &proc) {
|
||||
if (const auto *symbol{proc.GetSymbol()}) {
|
||||
|
|
@ -1907,11 +1863,18 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
|
|||
return MakeFunctionRef(loc, ActualArguments{std::move(*arg)});
|
||||
}
|
||||
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &) {
|
||||
Say("TODO: DefinedUnary unimplemented"_err_en_US);
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
|
||||
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
|
||||
ArgumentAnalyzer analyzer{*this};
|
||||
analyzer.Analyze(std::get<1>(x.t));
|
||||
if (analyzer.success()) {
|
||||
if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
|
||||
return MakeFunctionRef(name.source,
|
||||
std::move(callee->procedureDesignator), std::move(callee->arguments));
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
// Binary (dyadic) operations
|
||||
|
||||
// TODO: check defined operators for illegal intrinsic operator cases
|
||||
|
|
@ -2076,8 +2039,17 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::XOR &x) {
|
|||
return LogicalHelper(*this, LogicalOperator::Neqv, x);
|
||||
}
|
||||
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &) {
|
||||
Say("TODO: DefinedBinary unimplemented"_err_en_US);
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
|
||||
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
|
||||
ArgumentAnalyzer analyzer{*this};
|
||||
analyzer.Analyze(std::get<1>(x.t));
|
||||
analyzer.Analyze(std::get<2>(x.t));
|
||||
if (analyzer.success()) {
|
||||
if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
|
||||
return MakeFunctionRef(name.source,
|
||||
std::move(callee->procedureDesignator), std::move(callee->arguments));
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
|
|
@ -2390,8 +2362,84 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
|
|||
return std::nullopt;
|
||||
}
|
||||
}
|
||||
|
||||
void ArgumentAnalyzer::Analyze(
|
||||
const parser::ActualArgSpec &arg, bool isSubroutine) {
|
||||
// TODO: C1002: Allow a whole assumed-size array to appear if the dummy
|
||||
// argument would accept it. Handle by special-casing the context
|
||||
// ActualArg -> Variable -> Designator.
|
||||
// TODO: Actual arguments that are procedures and procedure pointers need to
|
||||
// be detected and represented (they're not expressions).
|
||||
// TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
|
||||
std::optional<ActualArgument> actual;
|
||||
std::visit(
|
||||
common::visitors{
|
||||
[&](const common::Indirection<parser::Expr> &x) {
|
||||
// TODO: Distinguish & handle procedure name and
|
||||
// proc-component-ref
|
||||
actual = Analyze(x.value());
|
||||
},
|
||||
[&](const parser::AltReturnSpec &) {
|
||||
if (!isSubroutine) {
|
||||
context_.Say("alternate return specification may not appear on"
|
||||
" function reference"_err_en_US);
|
||||
}
|
||||
},
|
||||
[&](const parser::ActualArg::PercentRef &) {
|
||||
context_.Say("TODO: %REF() argument"_err_en_US);
|
||||
},
|
||||
[&](const parser::ActualArg::PercentVal &) {
|
||||
context_.Say("TODO: %VAL() argument"_err_en_US);
|
||||
},
|
||||
},
|
||||
std::get<parser::ActualArg>(arg.t).u);
|
||||
if (actual.has_value()) {
|
||||
if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
|
||||
actual->keyword = argKW->v.source;
|
||||
}
|
||||
actuals_.emplace_back(std::move(*actual));
|
||||
} else {
|
||||
success_ = false;
|
||||
}
|
||||
}
|
||||
|
||||
std::optional<ActualArgument> ArgumentAnalyzer::Analyze(
|
||||
const parser::Expr &expr) {
|
||||
if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
|
||||
return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
|
||||
} else if (MaybeExpr argExpr{context_.Analyze(expr)}) {
|
||||
Expr<SomeType> x{Fold(context_.GetFoldingContext(), std::move(*argExpr))};
|
||||
if (const auto *proc{std::get_if<ProcedureDesignator>(&x.u)}) {
|
||||
if (!std::holds_alternative<SpecificIntrinsic>(proc->u) &&
|
||||
proc->IsElemental()) { // C1533
|
||||
context_.Say(expr.source,
|
||||
"Non-intrinsic ELEMENTAL procedure cannot be passed as argument"_err_en_US);
|
||||
}
|
||||
}
|
||||
if (auto coarrayRef{ExtractCoarrayRef(x)}) {
|
||||
const Symbol &coarray{coarrayRef->GetLastSymbol()};
|
||||
if (const semantics::DeclTypeSpec * type{coarray.GetType()}) {
|
||||
if (const semantics::DerivedTypeSpec * derived{type->AsDerived()}) {
|
||||
if (auto ptr{semantics::FindPointerUltimateComponent(*derived)}) {
|
||||
if (auto *msg{context_.Say(expr.source,
|
||||
"Coindexed object '%s' with POINTER ultimate component '%s' cannot be passed as argument"_err_en_US,
|
||||
coarray.name(), (*ptr)->name())}) {
|
||||
msg->Attach((*ptr)->name(),
|
||||
"Declaration of POINTER '%s' component of %s"_en_US,
|
||||
(*ptr)->name(), type->AsFortran());
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return ActualArgument{std::move(x)};
|
||||
} else {
|
||||
return std::nullopt;
|
||||
}
|
||||
}
|
||||
|
||||
} // namespace Fortran::evaluate
|
||||
|
||||
namespace Fortran::semantics {
|
||||
evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
|
||||
SemanticsContext &context, common::TypeCategory category,
|
||||
|
|
|
|||
|
|
@ -326,11 +326,12 @@ private:
|
|||
const parser::Call &, bool isSubroutine);
|
||||
std::optional<characteristics::Procedure> CheckCall(
|
||||
parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
|
||||
const Symbol *ResolveGeneric(
|
||||
const Symbol &, ActualArguments &, const semantics::Scope &);
|
||||
const Symbol *ResolveGeneric(const Symbol &, ActualArguments &);
|
||||
std::optional<CalleeAndArguments> GetCalleeAndArguments(
|
||||
const parser::Name &, ActualArguments &&, bool isSubroutine = false);
|
||||
std::optional<CalleeAndArguments> GetCalleeAndArguments(
|
||||
const parser::ProcedureDesignator &, ActualArguments &&,
|
||||
bool isSubroutine, const semantics::Scope &);
|
||||
bool isSubroutine);
|
||||
|
||||
void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
|
||||
bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
#include "scope.h"
|
||||
#include "semantics.h"
|
||||
#include "symbol.h"
|
||||
#include "tools.h"
|
||||
#include "../evaluate/tools.h"
|
||||
#include "../parser/message.h"
|
||||
#include "../parser/parsing.h"
|
||||
|
|
@ -356,11 +357,6 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
|
|||
}
|
||||
}
|
||||
|
||||
static bool IsDefinedOp(const Symbol &symbol) {
|
||||
const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()};
|
||||
return details && details->kind() == GenericKind::DefinedOp;
|
||||
}
|
||||
|
||||
static bool IsIntrinsicOp(const Symbol &symbol) {
|
||||
if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {
|
||||
GenericKind kind{details->kind()};
|
||||
|
|
@ -371,7 +367,7 @@ static bool IsIntrinsicOp(const Symbol &symbol) {
|
|||
}
|
||||
|
||||
static std::ostream &PutGenericName(std::ostream &os, const Symbol &symbol) {
|
||||
if (IsDefinedOp(symbol)) {
|
||||
if (IsGenericDefinedOp(symbol)) {
|
||||
return os << "operator(" << symbol.name() << ')';
|
||||
} else {
|
||||
return os << symbol.name();
|
||||
|
|
|
|||
|
|
@ -80,6 +80,11 @@ const Scope *FindPureProcedureContaining(const Scope *scope) {
|
|||
return nullptr;
|
||||
}
|
||||
|
||||
bool IsGenericDefinedOp(const Symbol &symbol) {
|
||||
const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()};
|
||||
return details && details->kind() == GenericKind::DefinedOp;
|
||||
}
|
||||
|
||||
bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) {
|
||||
const auto &objects{block.get<CommonBlockDetails>().objects()};
|
||||
auto found{std::find(objects.begin(), objects.end(), &object)};
|
||||
|
|
|
|||
|
|
@ -50,6 +50,7 @@ const Symbol *FindFunctionResult(const Symbol &);
|
|||
// Return the Symbol of the variable of a construct association, if it exists
|
||||
const Symbol *GetAssociationRoot(const Symbol &);
|
||||
|
||||
bool IsGenericDefinedOp(const Symbol &);
|
||||
bool IsCommonBlockContaining(const Symbol &block, const Symbol &object);
|
||||
bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent);
|
||||
bool DoesScopeContain(const Scope *, const Symbol &);
|
||||
|
|
|
|||
|
|
@ -233,3 +233,105 @@ end
|
|||
! real(4) :: y(1_8:ubound(f_elem(x), 1_4))
|
||||
! end
|
||||
!end
|
||||
|
||||
! Resolve defined unary operator based on type
|
||||
module m4
|
||||
interface operator(.foo.)
|
||||
pure integer(8) function f_real(x)
|
||||
real, intent(in) :: x
|
||||
end
|
||||
pure integer(8) function f_integer(x)
|
||||
integer, intent(in) :: x
|
||||
end
|
||||
end interface
|
||||
contains
|
||||
subroutine s1(x, y)
|
||||
real :: x
|
||||
real :: y(.foo. x) ! resolves to f_real
|
||||
end
|
||||
subroutine s2(x, y)
|
||||
integer :: x
|
||||
real :: y(.foo. x) ! resolves to f_integer
|
||||
end
|
||||
end
|
||||
!Expect: m4.mod
|
||||
!module m4
|
||||
! interface operator(.foo.)
|
||||
! procedure :: f_real
|
||||
! procedure :: f_integer
|
||||
! end interface
|
||||
! interface
|
||||
! pure function f_real(x)
|
||||
! real(4), intent(in) :: x
|
||||
! integer(8) :: f_real
|
||||
! end
|
||||
! end interface
|
||||
! interface
|
||||
! pure function f_integer(x)
|
||||
! integer(4), intent(in) :: x
|
||||
! integer(8) :: f_integer
|
||||
! end
|
||||
! end interface
|
||||
!contains
|
||||
! subroutine s1(x, y)
|
||||
! real(4) :: x
|
||||
! real(4) :: y(1_8:f_real(x))
|
||||
! end
|
||||
! subroutine s2(x, y)
|
||||
! integer(4) :: x
|
||||
! real(4) :: y(1_8:f_integer(x))
|
||||
! end
|
||||
!end
|
||||
|
||||
! Resolve defined binary operator based on type
|
||||
module m5
|
||||
interface operator(.foo.)
|
||||
pure integer(8) function f1(x, y)
|
||||
real, intent(in) :: x
|
||||
real, intent(in) :: y
|
||||
end
|
||||
pure integer(8) function f2(x, y)
|
||||
real, intent(in) :: x
|
||||
complex, intent(in) :: y
|
||||
end
|
||||
end interface
|
||||
contains
|
||||
subroutine s1(x, y)
|
||||
complex :: x
|
||||
real :: y(1.0 .foo. x) ! resolves to f2
|
||||
end
|
||||
subroutine s2(x, y)
|
||||
real :: x
|
||||
real :: y(1.0 .foo. x) ! resolves to f1
|
||||
end
|
||||
end
|
||||
!Expect: m5.mod
|
||||
!module m5
|
||||
! interface operator(.foo.)
|
||||
! procedure :: f1
|
||||
! procedure :: f2
|
||||
! end interface
|
||||
! interface
|
||||
! pure function f1(x, y)
|
||||
! real(4), intent(in) :: x
|
||||
! real(4), intent(in) :: y
|
||||
! integer(8) :: f1
|
||||
! end
|
||||
! end interface
|
||||
! interface
|
||||
! pure function f2(x, y)
|
||||
! real(4), intent(in) :: x
|
||||
! complex(4), intent(in) :: y
|
||||
! integer(8) :: f2
|
||||
! end
|
||||
! end interface
|
||||
!contains
|
||||
! subroutine s1(x, y)
|
||||
! complex(4) :: x
|
||||
! real(4) :: y(1_8:f2(1._4, x))
|
||||
! end
|
||||
! subroutine s2(x, y)
|
||||
! real(4) :: x
|
||||
! real(4) :: y(1_8:f1(1._4, x))
|
||||
! end
|
||||
!end
|
||||
|
|
|
|||
|
|
@ -42,3 +42,50 @@ subroutine s2
|
|||
a = f(1.0)
|
||||
a = f(y) !TODO: this should resolve to f2 -- should get error here
|
||||
end
|
||||
|
||||
! Resolve named operator
|
||||
subroutine s3
|
||||
interface operator(.foo.)
|
||||
pure integer(8) function f_real(x, y)
|
||||
real, intent(in) :: x, y
|
||||
end
|
||||
pure integer(8) function f_integer(x, y)
|
||||
integer, intent(in) :: x, y
|
||||
end
|
||||
end interface
|
||||
logical :: a, b, c
|
||||
x = y .foo. z ! OK: f_real
|
||||
i = j .foo. k ! OK: f_integer
|
||||
!ERROR: No specific procedure of generic operator '.foo.' matches the actual arguments
|
||||
a = b .foo. c
|
||||
end
|
||||
|
||||
! Generic resolves successfully but error analyzing call
|
||||
module m4
|
||||
real, protected :: x
|
||||
real :: y
|
||||
interface s
|
||||
subroutine s1(x)
|
||||
real, intent(out) :: x
|
||||
end
|
||||
subroutine s2(x, y)
|
||||
real :: x, y
|
||||
end
|
||||
end interface
|
||||
end
|
||||
subroutine s4a
|
||||
use m4
|
||||
real :: z
|
||||
!OK
|
||||
call s(z)
|
||||
end
|
||||
subroutine s4b
|
||||
use m4
|
||||
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
|
||||
call s(x)
|
||||
end
|
||||
pure subroutine s4c
|
||||
use m4
|
||||
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
|
||||
call s(y)
|
||||
end
|
||||
|
|
|
|||
Loading…
Reference in New Issue