[flang] Better messages for function vs. array errors

[klausler]

Summary

When a scalar-valued function with no distinct RESULT
is being called recursively in its own executable part,
emit a better message about the error. Clean up the
code that resolves function vs. array ambiguities in
expression semantics.

[PeteSteinfeld]

Aside from that one nit, all builds, tests, and looks good.

flang/lib/Semantics/expression.cpp

2815

This is the only use of "hasArgs". You could just put the code that defines it here.

[klausler]

Update to address review comment.

[klausler]

Please take another look at the updated patch at your convenience and confirm that your comment has been addressed to your satisfaction; thanks!

[PeteSteinfeld]

Looks great! Thanks for the update.

flang/include/flang/Semantics/tools.h

 }
 bool IsInStmtFunction(const Symbol &);
 bool IsStmtFunctionDummy(const Symbol &);
 bool IsStmtFunctionResult(const Symbol &);
 bool IsPointerDummy(const Symbol &);
 bool IsBindCProcedure(const Symbol &);
 bool IsBindCProcedure(const Scope &);
 bool IsProcName(const Symbol &); // proc-name
-bool IsFunctionResultWithSameNameAsFunction(const Symbol &);
+// Returns a pointer to the function's symbol when true, else null
+const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &);
 bool IsOrContainsEventOrLockComponent(const Symbol &);
 bool CanBeTypeBoundProc(const Symbol *);
 // Does a non-PARAMETER symbol have explicit initialization with =value or
 // =>target in its declaration (but not in a DATA statement)? (Being
 // ALLOCATABLE or having a derived type with default component initialization
 // doesn't count; it must be a variable initialization that implies the SAVE
 // attribute, or a derived type component default value.)
 bool HasDeclarationInitializer(const Symbol &);

flang/lib/Semantics/expression.cpp

MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
   const auto &name{std::get<parser::DefinedOpName>(x.t).v};
   ArgumentAnalyzer analyzer{*this, name.source};
   analyzer.Analyze(std::get<1>(x.t));
   analyzer.Analyze(std::get<2>(x.t));
   return analyzer.TryDefinedOp(name.source.ToString().c_str(),
       "No operator %s defined for %s and %s"_err_en_US, nullptr, true);
 }
 
-static void CheckFuncRefToArrayElementRefHasSubscripts(
-    semantics::SemanticsContext &context,
+// Returns true if a parsed function reference should be converted
+// into an array element reference.
+static bool CheckFuncRefToArrayElement(semantics::SemanticsContext &context,
     const parser::FunctionReference &funcRef) {
   // Emit message if the function reference fix will end up an array element
-  // reference with no subscripts because it will not be possible to later tell
-  // the difference in expressions between empty subscript list due to bad
-  // subscripts error recovery or because the user did not put any.
-  if (std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t).empty()) {
-    auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
-    const auto *name{std::get_if<parser::Name>(&proc.u)};
-    if (!name) {
-      name = &std::get<parser::ProcComponentRef>(proc.u).v.thing.component;
-    }
+  // reference with no subscripts, or subscripts on a scalar, because it will
+  // not be possible to later distinguish in expressions between an empty
+  // subscript list due to bad subscripts error recovery or because the
+  // user did not put any.
+  if (!name->symbol) {
+    return false;
+  } else if (name->symbol->Rank() == 0) {
+    if (const Symbol *
+        function{
+            semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)}) {
       auto &msg{context.Say(funcRef.v.source,
-        name->symbol && name->symbol->Rank() == 0
-            ? "'%s' is not a function"_err_en_US
-            : "Reference to array '%s' with empty subscript list"_err_en_US,
+          "Recursive call to '%s' requires a distinct RESULT in its declaration"_err_en_US,
           name->source)};
-    if (name->symbol) {
-      if (semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)) {
-        msg.Attach(name->source,
-            "A result variable must be declared with RESULT to allow recursive "
-            "function calls"_en_US);
-      } else {
+      AttachDeclaration(&msg, *function);
+      name->symbol = const_cast<Symbol *>(function);
+    }
+    return false;
+    if (std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t).empty()) {
+      auto &msg{context.Say(funcRef.v.source,
+          "Reference to array '%s' with empty subscript list"_err_en_US,
+          name->source)};
+      if (name->symbol) {
         AttachDeclaration(&msg, *name->symbol);
       }
     }
+    return true;
   }
 }
 
 // Converts, if appropriate, an original misparse of ambiguous syntax like
 // A(1) as a function reference into an array reference.
 // Misparsed structure constructors are detected elsewhere after generic
 // function call resolution fails.
 template <typename... A>
if (Symbol *
                 proc.u)}) {
       Symbol &symbol{origSymbol->GetUltimate()};
       if (symbol.has<semantics::ObjectEntityDetails>() ||
           symbol.has<semantics::AssocEntityDetails>()) {
         // Note that expression in AssocEntityDetails cannot be a procedure
         // pointer as per C1105 so this cannot be a function reference.
         if constexpr (common::HasMember<common::Indirection<parser::Designator>,
                           uType>) {
-          CheckFuncRefToArrayElementRefHasSubscripts(context, funcRef);
+          if (CheckFuncRefToArrayElement(context, funcRef)) {
             u = common::Indirection{funcRef.ConvertToArrayElementRef()};
+          }
         } else {
           DIE("can't fix misparsed function as array reference");
         }
       }
     }
   }
 }
 

flang/lib/Semantics/tools.cpp

if (parent) {
           }
         }
       }
     }
   }
   return nullptr;
 }
 
-bool IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
+const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
   if (IsFunctionResult(symbol)) {
     if (const Symbol * function{symbol.owner().symbol()}) {
-      return symbol.name() == function->name();
+      if (symbol.name() == function->name()) {
+        return function;
       }
     }
-  return false;
+  }
+  return nullptr;
 }
 
 void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) {
   checkLabelUse(gotoStmt.v);
 }
 void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) {
   for (auto &i : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
     checkLabelUse(i);

flang/test/Semantics/resolve59.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Testing 15.6.2.2 point 4 (What function-name refers to depending on the
 ! presence of RESULT).
 
 
 module m_no_result
 ! Without RESULT, it refers to the result object (no recursive
 ! calls possible)
 contains
   ! testing with data object results
   function f1()
     real :: x, f1
-    !ERROR: 'f1' is not a function
+    !ERROR: Recursive call to 'f1' requires a distinct RESULT in its declaration
     x = acos(f1())
     f1 = x
     x = acos(f1) !OK
   end function
   function f2(i)
     integer i
     real :: x, f2
-    !ERROR: 'f2' is not an array
+    !ERROR: Recursive call to 'f2' requires a distinct RESULT in its declaration
     x = acos(f2(i+1))
     f2 = x
     x = acos(f2) !OK
   end function
   function f3(i)
     integer i
     real :: x, f3(1)
     ! OK reference to array result f1
function f5(x)
     !ERROR: Actual argument for 'x=' may not be a procedure
     x = acos(f5)
   end function
   ! Sanity test: f18 handles C1560 violation by ignoring RESULT
   function f6() result(f6) !OKI (warning)
   end function
   function f7() result(f7) !OKI (warning)
     real :: x, f7
-    !ERROR: 'f7' is not a function
+    !ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration
     x = acos(f7())
     f7 = x
     x = acos(f7) !OK
   end function
 end module
 
 module m_with_result
 ! With RESULT, it refers to the function (recursive calls possible)
function f5(x) result(r)
     !ERROR: Actual argument for 'x=' may not be a procedure
     x = acos(f5)
     x = acos(r(x+1)) ! OK
   end function
 
   ! testing that calling the result is also caught
   function f6() result(r)
     real :: x, r
-    !ERROR: 'r' is not a function
+    !ERROR: 'r' is not a callable procedure
     x = r()
   end function
 end module
 
 subroutine array_rank_test()
   real :: x(10, 10), y
   !ERROR: Reference to rank-2 object 'x' has 1 subscripts
   y = x(1)
   !ERROR: Reference to rank-2 object 'x' has 3 subscripts
   y = x(1, 2, 3)
 end

flang/test/Semantics/resolve93.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 subroutine s1()
   character(10) str
   character(10) str1
   !ERROR: Cannot reference function 'str' as data
   print *, str(1:9), str(7)
   block
     character(10) str2
     character(10) str3
     !ERROR: Cannot reference function 'str1' as data
     print *, str1(1:9), str1(7)
-    !ERROR: 'str2' is not an array
-    print *, str2(1:9), str2(7)
+    print *, str2(1:9) ! substring is ok
+    !ERROR: 'str2' is not a callable procedure
+    print *, str2(7)
     !ERROR: Cannot reference function 'str3' as data
     print *, str3(7), str3(1:9)
   end block
 end subroutine s1
 
 subroutine s2()
   character(10) func
   !ERROR: Cannot reference function 'func' as data