diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -295,11 +295,11 @@ 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 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -468,7 +468,23 @@ [&](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 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1863,8 +1863,9 @@ // 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 @@ "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 @@ 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 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -822,7 +822,9 @@ } 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 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1860,6 +1860,7 @@ 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 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -44,11 +44,13 @@ : 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 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3102,6 +3102,7 @@ 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 --- a/flang/test/Semantics/resolve102.f90 +++ b/flang/test/Semantics/resolve102.f90 @@ -85,3 +85,18 @@ 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