[flang] Complain about more cases of calls to insufficiently defined procedures

[klausler]

Summary

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.

[PeteSteinfeld]

Things build OK, but I when I run the tests, I get failures in implicit07.f90 and resolve29.f90.

Also, I wonder about the two identical error messages in characteristics.cpp.

flang/lib/Evaluate/characteristics.cpp

473–475

Is this the error message that you meant to use for something that has EntityDetails? In particular, this message is identical to the message below for something with SubprogramNameDetails.

[klausler]

In D104330#2821068, @PeteSteinfeld wrote:

Things build OK, but I when I run the tests, I get failures in implicit07.f90 and resolve29.f90.

Also, I wonder about the two identical error messages in characteristics.cpp.

I think that those failures are due to a dependence on other changes; they're now merged, and those tests should now pass for you like they do for me.

It's okay that those two cases (EntityDetails and SubprogramNameDetails) emit the same message.

[PeteSteinfeld]

In my latest attempt to build and test this, .../test/Semantics/call19.f90 is failing because it's producing extra messages regarding entities that are "not a procedure". But I trust you to make sure that everything works after integration with the latest sources.

flang/include/flang/Evaluate/characteristics.h

struct Procedure {
   Procedure(){};
   Procedure(FunctionResult &&, DummyArguments &&, Attrs);
   Procedure(DummyArguments &&, Attrs); // for subroutines and NULL()
   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
   ~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(
       const ProcedureRef &, FoldingContext &);
 
   // At most one of these will return true.
   // For "EXTERNAL P" with no type for or calls to P, both will be false.
   bool IsFunction() const { return functionResult.has_value(); }

flang/lib/Evaluate/characteristics.cpp

return std::visit(
             }
           },
           [&](const semantics::UseDetails &use) {
             return CharacterizeProcedure(use.symbol(), context, seenProcs);
           },
           [&](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());
 }
 
 static std::optional<DummyProcedure> CharacterizeDummyProcedure(
     const semantics::Symbol &symbol, FoldingContext &context,
     semantics::UnorderedSymbolSet &seenProcs) {
   if (auto procedure{CharacterizeProcedure(symbol, context, seenProcs)}) {

flang/lib/Evaluate/intrinsics.cpp

if (Expr<SomeType> * mold{arguments[0]->UnwrapExpr()}) {
       bool goodProcPointer{true};
       if (IsAllocatableOrPointer(*mold)) {
         characteristics::DummyArguments args;
         std::optional<characteristics::FunctionResult> fResult;
         if (IsProcedurePointerTarget(*mold)) {
           // 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) {
             args.emplace_back("mold"s,
                 characteristics::DummyProcedure{common::Clone(*procPointer)});
             fResult.emplace(std::move(*procPointer));
           } else {
             goodProcPointer = false;
if (const auto &pointerArg{call.arguments[0]}) {
     if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
       if (const Symbol * pointerSymbol{GetLastSymbol(*pointerExpr)}) {
         if (!pointerSymbol->attrs().test(semantics::Attr::POINTER)) {
           AttachDeclaration(context.messages().Say(
                                 "POINTER= argument of ASSOCIATED() must be a "
                                 "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;
               if (const auto *targetProcRef{// target is a function call
                       std::get_if<ProcedureRef>(&targetExpr->u)}) {
                 if (auto targetRefedChars{
                         characteristics::Procedure::Characterize(
                             *targetProcRef, context)}) {
                   targetProc = *targetRefedChars;
                   targetName = targetProcRef->proc().GetName() + "()";
                   isCall = true;
                 }
-              } else if (targetSymbol && !targetProc) {
+              } else if (targetSymbol) {
                 // proc that's not a call
+                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
                   if (std::optional<parser::MessageFixedText> msg{
                           CheckProcCompatibility(
                               isCall, pointerProc, &*targetProc)}) {
                     AttachDeclaration(
                         context.messages().Say(std::move(*msg),

flang/lib/Semantics/check-declarations.cpp

if (entryScope->kind() != Scope::Kind::Subprogram) {
       error = "ENTRY may appear only in a subroutine or function"_err_en_US;
     } else if (!(entryScope->parent().IsGlobal() ||
                    entryScope->parent().IsModule() ||
                    entryScope->parent().IsSubmodule())) {
       error = "ENTRY may not appear in an internal subprogram"_err_en_US;
     } 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(
           subprogramDetails->result(), context_.foldingContext())};
       if (result && subpResult && *result != *subpResult &&
           (!IsResultOkToDiffer(*result) || !IsResultOkToDiffer(*subpResult))) {
         error =
             "Result of ENTRY is not compatible with result of containing function"_err_en_US;

flang/lib/Semantics/expression.cpp

if (const Symbol * sym{sc.component.symbol}) {
       if (context_.HasError(sym)) {
         return std::nullopt;
       }
       if (!IsProcedure(*sym)) {
         AttachDeclaration(
             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>()) {
           AdjustActuals adjustment{
               [&](const Symbol &proc, ActualArguments &actuals) {
                 if (!proc.attrs().test(semantics::Attr::NOPASS)) {
                   AddPassArg(actuals, std::move(*dtExpr), proc);
                 }

flang/lib/Semantics/pointer-assignment.cpp

 
 class PointerAssignmentChecker {
 public:
   PointerAssignmentChecker(evaluate::FoldingContext &context,
       parser::CharBlock source, const std::string &description)
       : 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);
   PointerAssignmentChecker &set_isVolatile(bool);
   PointerAssignmentChecker &set_isBoundsRemapping(bool);
   bool Check(const SomeExpr &);
 
 private:

flang/lib/Semantics/resolve-names.cpp

if (resultSymbol) { // C1574
       std::visit(
           common::visitors{[](EntityDetails &x) { x.set_funcResult(true); },
               [](ObjectEntityDetails &x) { x.set_funcResult(true); },
               [](ProcEntityDetails &x) { x.set_funcResult(true); },
               [&](const auto &) {
                 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_) {
       ObjectEntityDetails entity;
       entity.set_funcResult(true);
       resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
       ApplyImplicitRules(*resultSymbol);
     } else {

flang/test/Semantics/resolve102.f90

program threeCycle
   procedure(p1) p2
   !ERROR: The interface for procedure 'p3' is recursively defined
   procedure(p2) p3
   procedure(p3) p1
   call p1
   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