From 562bfe1274a17698c445ee3d7bb4a7911d74f657 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 15 Jun 2021 15:17:16 -0700 Subject: [PATCH] [flang] Complain about more cases of calls to insufficiently defined procedures When a function is called in a specification expression, it must be sufficiently defined, and cannot be a recursive call (10.1.11(5)). The best fix for this is to change the contract for the procedure characterization infrastructure to catch and report such errors, and to guarantee that it does emit errors on failed characterizations. Some call sites were adjusted to avoid cascades. Differential Revision: https://reviews.llvm.org/D104330 --- .../include/flang/Evaluate/characteristics.h | 4 ++-- flang/lib/Evaluate/characteristics.cpp | 18 ++++++++++++++- flang/lib/Evaluate/intrinsics.cpp | 23 +++++++++++-------- flang/lib/Semantics/check-declarations.cpp | 4 +++- flang/lib/Semantics/expression.cpp | 1 + flang/lib/Semantics/pointer-assignment.cpp | 6 +++-- flang/lib/Semantics/resolve-names.cpp | 1 + flang/test/Semantics/resolve102.f90 | 15 ++++++++++++ 8 files changed, 56 insertions(+), 16 deletions(-) diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h index 8006f7a09c04..619f3c96b407 100644 --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -295,11 +295,11 @@ struct Procedure { bool operator==(const Procedure &) const; bool operator!=(const Procedure &that) const { return !(*this == that); } - // Characterizes the procedure represented by a symbol, which may be an + // Characterizes a procedure. If a Symbol, it may be an // "unrestricted specific intrinsic function". + // Error messages are produced when a procedure cannot be characterized. static std::optional Characterize( const semantics::Symbol &, FoldingContext &); - // This function is the initial point of entry for characterizing procedure static std::optional Characterize( const ProcedureDesignator &, FoldingContext &); static std::optional Characterize( diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 80f5f23fa53b..3fd0025dc83f 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -468,7 +468,23 @@ static std::optional CharacterizeProcedure( [&](const semantics::HostAssocDetails &assoc) { return CharacterizeProcedure(assoc.symbol(), context, seenProcs); }, - [](const auto &) { return std::optional{}; }, + [&](const semantics::EntityDetails &) { + context.messages().Say( + "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US, + symbol.name()); + return std::optional{}; + }, + [&](const semantics::SubprogramNameDetails &) { + context.messages().Say( + "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US, + symbol.name()); + return std::optional{}; + }, + [&](const auto &) { + context.messages().Say( + "'%s' is not a procedure"_err_en_US, symbol.name()); + return std::optional{}; + }, }, symbol.details()); } diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index a63f845c03e0..c8d8b02d58ab 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1863,8 +1863,9 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull( // MOLD= procedure pointer const Symbol *last{GetLastSymbol(*mold)}; CHECK(last); - auto procPointer{ - characteristics::Procedure::Characterize(*last, context)}; + auto procPointer{IsProcedure(*last) + ? characteristics::Procedure::Characterize(*last, context) + : std::nullopt}; // procPointer is null if there was an error with the analysis // associated with the procedure pointer if (procPointer) { @@ -2000,12 +2001,9 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) { "POINTER"_err_en_US), *pointerSymbol); } else { - const auto pointerProc{characteristics::Procedure::Characterize( - *pointerSymbol, context)}; if (const auto &targetArg{call.arguments[1]}) { if (const auto *targetExpr{targetArg->UnwrapExpr()}) { - std::optional targetProc{ - std::nullopt}; + std::optional pointerProc, targetProc; const Symbol *targetSymbol{GetLastSymbol(*targetExpr)}; bool isCall{false}; std::string targetName; @@ -2018,13 +2016,18 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) { targetName = targetProcRef->proc().GetName() + "()"; isCall = true; } - } else if (targetSymbol && !targetProc) { + } else if (targetSymbol) { // proc that's not a call - targetProc = characteristics::Procedure::Characterize( - *targetSymbol, context); + if (IsProcedure(*targetSymbol)) { + targetProc = characteristics::Procedure::Characterize( + *targetSymbol, context); + } targetName = targetSymbol->name().ToString(); } - + if (IsProcedure(*pointerSymbol)) { + pointerProc = characteristics::Procedure::Characterize( + *pointerSymbol, context); + } if (pointerProc) { if (targetProc) { // procedure pointer and procedure target diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 56c126b5bc1c..ddf0a011b2f7 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -822,7 +822,9 @@ void CheckHelper::CheckSubprogram( } else if (FindSeparateModuleSubprogramInterface(subprogram)) { error = "ENTRY may not appear in a separate module procedure"_err_en_US; } else if (subprogramDetails && details.isFunction() && - subprogramDetails->isFunction()) { + subprogramDetails->isFunction() && + !context_.HasError(details.result()) && + !context_.HasError(subprogramDetails->result())) { auto result{FunctionResult::Characterize( details.result(), context_.foldingContext())}; auto subpResult{FunctionResult::Characterize( diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 42d6a2ac2007..95943b3837bc 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1860,6 +1860,7 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef( Say(sc.component.source, "'%s' is not a procedure"_err_en_US, sc.component.source), *sym); + return std::nullopt; } if (auto *dtExpr{UnwrapExpr>(*base)}) { if (sym->has()) { diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp index 171e2ba02477..afa15522127d 100644 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -44,11 +44,13 @@ public: : context_{context}, source_{source}, description_{description} {} PointerAssignmentChecker(evaluate::FoldingContext &context, const Symbol &lhs) : context_{context}, source_{lhs.name()}, - description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs}, - procedure_{Procedure::Characterize(lhs, context)} { + description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} { set_lhsType(TypeAndShape::Characterize(lhs, context)); set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS)); set_isVolatile(lhs.attrs().test(Attr::VOLATILE)); + if (IsProcedure(lhs)) { + procedure_ = Procedure::Characterize(lhs, context); + } } PointerAssignmentChecker &set_lhsType(std::optional &&); PointerAssignmentChecker &set_isContiguous(bool); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index efba039fe9b3..5ab4d39590d9 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3102,6 +3102,7 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { Say2(effectiveResultName.source, "'%s' was previously declared as an item that may not be used as a function result"_err_en_US, resultSymbol->name(), "Previous declaration of '%s'"_en_US); + context().SetError(*resultSymbol); }}, resultSymbol->details()); } else if (inExecutionPart_) { diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90 index aae461d108d8..77b5e10369fe 100644 --- a/flang/test/Semantics/resolve102.f90 +++ b/flang/test/Semantics/resolve102.f90 @@ -85,3 +85,18 @@ program threeCycle call p2 call p3 end program + +module mutualSpecExprs +contains + pure integer function f(n) + integer, intent(in) :: n + real arr(g(n)) + f = size(arr) + end function + pure integer function g(n) + integer, intent(in) :: n + !ERROR: Procedure 'f' is referenced before being sufficiently defined in a context where it must be so + real arr(f(n)) + g = size(arr) + end function +end