[flang] Improve error messages for procedures in expressions

When a procedure name was used on the RHS of an assignment we were not
reporting the error. When one was used in an expression the error
message wasn't very good (e.g. "Operands of + must be numeric; have
INTEGER(4) and untyped").

Detect these cases in ArgumentAnalyzer and emit better messages,
depending on whether the named procedure is a function or subroutine.

Procedure names may appear as actual arguments to function and
subroutine calls so don't report errors in those cases. That is the same
case where assumed type arguments are allowed, so rename `isAssumedType_`
to `isProcedureCall_` and use that to decide if it is an error.

Differential Revision: https://reviews.llvm.org/D86107

flang/include/flang/Evaluate/tools.h

@@ -813,6 +813,7 @@ template <typename A> bool IsAllocatableOrPointer(const A &x) {
 
 // Procedure and pointer detection predicates
 bool IsProcedure(const Expr<SomeType> &);
+bool IsFunction(const Expr<SomeType> &);
 bool IsProcedurePointer(const Expr<SomeType> &);
 bool IsNullPointer(const Expr<SomeType> &);
 

flang/lib/Evaluate/tools.cpp

@@ -703,6 +703,10 @@ bool IsAssumedRank(const ActualArgument &arg) {
 bool IsProcedure(const Expr<SomeType> &expr) {
   return std::holds_alternative<ProcedureDesignator>(expr.u);
 }
+bool IsFunction(const Expr<SomeType> &expr) {
+  const auto *designator{std::get_if<ProcedureDesignator>(&expr.u)};
+  return designator && designator->GetType().has_value();
+}
 
 bool IsProcedurePointer(const Expr<SomeType> &expr) {
   return std::visit(common::visitors{

flang/lib/Semantics/expression.cpp

@@ -98,11 +98,10 @@ static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
 class ArgumentAnalyzer {
 public:
   explicit ArgumentAnalyzer(ExpressionAnalyzer &context)
-      : context_{context}, allowAssumedType_{false} {}
+      : context_{context}, isProcedureCall_{false} {}
   ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source,
-      bool allowAssumedType = false)
-      : context_{context}, source_{source}, allowAssumedType_{
-                                                allowAssumedType} {}
+      bool isProcedureCall = false)
+      : context_{context}, source_{source}, isProcedureCall_{isProcedureCall} {}
   bool fatalErrors() const { return fatalErrors_; }
   ActualArguments &&GetActuals() {
     CHECK(!fatalErrors_);
@@ -167,7 +166,7 @@ class ArgumentAnalyzer {
   ActualArguments actuals_;
   parser::CharBlock source_;
   bool fatalErrors_{false};
-  const bool allowAssumedType_;
+  const bool isProcedureCall_; // false for user-defined op or assignment
   const Symbol *sawDefinedOp_{nullptr};
 };
 
@@ -2003,7 +2002,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
     std::optional<parser::StructureConstructor> *structureConstructor) {
   const parser::Call &call{funcRef.v};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
-  ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */};
+  ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
   for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
     analyzer.Analyze(arg, false /* not subroutine call */);
   }
@@ -2042,7 +2041,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
 void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
   const parser::Call &call{callStmt.v};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
-  ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */};
+  ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
   const auto &actualArgList{std::get<std::list<parser::ActualArgSpec>>(call.t)};
   for (const auto &arg : actualArgList) {
     analyzer.Analyze(arg, true /* is subroutine call */);
@@ -2982,14 +2981,24 @@ std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
   source_.ExtendToCover(expr.source);
   if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
     expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter);
-    if (allowAssumedType_) {
+    if (isProcedureCall_) {
       return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
     } else {
       context_.SayAt(expr.source,
           "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
       return std::nullopt;
     }
   } else if (MaybeExpr argExpr{context_.Analyze(expr)}) {
+    if (!isProcedureCall_ && IsProcedure(*argExpr)) {
+      if (IsFunction(*argExpr)) {
+        context_.SayAt(
+            expr.source, "Function call must have argument list"_err_en_US);
+      } else {
+        context_.SayAt(
+            expr.source, "Subroutine name is not allowed here"_err_en_US);
+      }
+      return std::nullopt;
+    }
     return ActualArgument{context_.Fold(std::move(*argExpr))};
   } else {
     return std::nullopt;

flang/test/Semantics/assign04.f90

@@ -132,3 +132,12 @@ subroutine s10(a, n)
   real a(n)
   a(1:n) = 0.0  ! should not get a second error here
 end
+
+subroutine s11
+  intrinsic :: sin
+  real :: a
+  !ERROR: Function call must have argument list
+  a = sin
+  !ERROR: Subroutine name is not allowed here
+  a = s11
+end

flang/test/Semantics/resolve63.f90

@@ -104,6 +104,7 @@ subroutine test_conformability(x, y)
 
 ! Invalid operand types when user-defined operator is not available
 module m2
+  intrinsic :: sin
   type :: t
   end type
   type(t) :: x, y
@@ -113,6 +114,10 @@ module m2
   subroutine test_relational()
     !ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4)
     l = x == r
+    !ERROR: Subroutine name is not allowed here
+    l = r == test_numeric
+    !ERROR: Function call must have argument list
+    l = r == sin
   end
   subroutine test_numeric()
     !ERROR: Operands of + must be numeric; have REAL(4) and TYPE(t)