[flang] Improve error messages for procedures in expressions

[tskeith]

Summary

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.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Evaluate/tools.h

 // Predicate: IsAllocatableOrPointer()
 template <typename A> bool IsAllocatableOrPointer(const A &x) {
   return GetAttrs(x).HasAny(
       semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE});
 }
 
 // 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> &);
 
 // Extracts the chain of symbols from a designator, which has perhaps been
 // wrapped in an Expr<>, removing all of the (co)subscripts.  The
 // base object will be the first symbol in the result vector.
 struct GetSymbolVectorHelper
     : public Traverse<GetSymbolVectorHelper, SymbolVector> {

flang/lib/Evaluate/tools.cpp

if (const auto *expr{arg.UnwrapExpr()}) {
     CHECK(assumedTypeDummy);
     return IsAssumedRank(*assumedTypeDummy);
   }
 }
 
 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{
                         [](const NullPointer &) { return true; },
                         [](const ProcedureDesignator &) { return true; },
                         [](const ProcedureRef &) { return true; },
                         [](const auto &) { return false; },
                     },

flang/lib/Semantics/expression.cpp

if (spec) {
     }
   }
   return std::nullopt;
 }
 
 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_);
     return std::move(actuals_);
   }
   const Expr<SomeType> &GetExpr(std::size_t i) const {
     return DEREF(actuals_.at(i).value().UnwrapExpr());
   }
private:
   void SayNoMatch(const std::string &, bool isAssignment = false);
   std::string TypeAsFortran(std::size_t);
   bool AnyUntypedOperand();
 
   ExpressionAnalyzer &context_;
   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};
 };
 
 // Wraps a data reference in a typed Designator<>, and a procedure
 // or procedure pointer reference in a ProcedureDesignator.
 MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
   const Symbol &symbol{ref.GetLastSymbol().GetUltimate()};
   if (semantics::IsProcedure(symbol)) {
template <typename A> static const Symbol *AssumedTypeDummy(const A &x) {
   }
   return nullptr;
 }
 
 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 */);
   }
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   }
   if (std::optional<CalleeAndArguments> callee{
           GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
if (std::optional<CalleeAndArguments> callee{
     }
   }
   return std::nullopt;
 }
 
 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 */);
   }
   if (!analyzer.fatalErrors()) {
     if (std::optional<CalleeAndArguments> callee{
             GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
                 analyzer.GetActuals(), true /* subroutine */)}) {
for (const auto &actual : actuals_) {
     }
   }
 }
 std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
     const parser::Expr &expr) {
   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;
   }
 }
 
 bool ArgumentAnalyzer::AreConformable() const {
   CHECK(!fatalErrors_ && actuals_.size() == 2);

flang/test/Semantics/assign04.f90

 end
 
 !ERROR: No explicit type declared for 'n'
 subroutine s10(a, n)
   implicit none
   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

subroutine test_conformability(x, y)
     l = x + y  !OK
     !ERROR: No intrinsic or user-defined OPERATOR(+) matches rank 2 array of REAL(4) and rank 1 array of REAL(4)
     l = y + x
   end
 end
 
 ! Invalid operand types when user-defined operator is not available
 module m2
+  intrinsic :: sin
   type :: t
   end type
   type(t) :: x, y
   real :: r
   logical :: l
 contains
   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)
     l = r + x
   end
   subroutine test_logical()
     !ERROR: Operands of .AND. must be LOGICAL; have REAL(4) and TYPE(t)
     l = r .and. x