[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

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<Procedure> Characterize(
       const semantics::Symbol &, FoldingContext &);
-  // This function is the initial point of entry for characterizing procedure
   static std::optional<Procedure> Characterize(
       const ProcedureDesignator &, FoldingContext &);
   static std::optional<Procedure> Characterize(

flang/lib/Evaluate/characteristics.cpp

@@ -468,7 +468,23 @@ static std::optional<Procedure> CharacterizeProcedure(
           [&](const semantics::HostAssocDetails &assoc) {
             return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
           },
-          [](const auto &) { return std::optional<Procedure>{}; },
+          [&](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<Procedure>{};
+          },
+          [&](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<Procedure>{};
+          },
+          [&](const auto &) {
+            context.messages().Say(
+                "'%s' is not a procedure"_err_en_US, symbol.name());
+            return std::optional<Procedure>{};
+          },
       },
       symbol.details());
 }

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<characteristics::Procedure> targetProc{
-                  std::nullopt};
+              std::optional<characteristics::Procedure> 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

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(

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<Expr<SomeDerived>>(*base)}) {
         if (sym->has<semantics::GenericDetails>()) {

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<TypeAndShape> &&);
   PointerAssignmentChecker &set_isContiguous(bool);

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_) {

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