[flang] Better error message for RANK(NULL()) (llvm#93577)

We currently complain that the argument may not be a procedure, which is confusing. Distinguish the NULL() case from other error cases (which are indeed procedures). And clean up the utility predicates used for these tests -- the current IsProcedure() is really just a test for a procedure designator.
kraj · Jun 3, 2024 · c759334 · c759334
1 parent 13f6797
commit c759334
Show file tree

Hide file tree

Showing 7 changed files with 29 additions and 10 deletions.
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
@@ -1017,10 +1017,11 @@ bool IsAllocatableOrPointerObject(const Expr<SomeType> &);
 bool IsAllocatableDesignator(const Expr<SomeType> &);
 
 // Procedure and pointer detection predicates
-bool IsProcedure(const Expr<SomeType> &);
-bool IsFunction(const Expr<SomeType> &);
+bool IsProcedureDesignator(const Expr<SomeType> &);
+bool IsFunctionDesignator(const Expr<SomeType> &);
 bool IsPointer(const Expr<SomeType> &);
 bool IsProcedurePointer(const Expr<SomeType> &);
+bool IsProcedure(const Expr<SomeType> &);
 bool IsProcedurePointerTarget(const Expr<SomeType> &);
 bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
 bool IsNullObjectPointer(const Expr<SomeType> &);

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
@@ -1808,7 +1808,12 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
           continue;
         } else if (d.typePattern.kindCode == KindCode::nullPointerType) {
           continue;
+        } else if (IsNullPointer(expr)) {
+          messages.Say(arg->sourceLocation(),
+              "Actual argument for '%s=' may not be NULL()"_err_en_US,
+              d.keyword);
         } else {
+          CHECK(IsProcedure(expr));
           messages.Say(arg->sourceLocation(),
               "Actual argument for '%s=' may not be a procedure"_err_en_US,
               d.keyword);

diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
@@ -818,10 +818,10 @@ bool IsCoarray(const Symbol &symbol) {
   return GetAssociationRoot(symbol).Corank() > 0;
 }
 
-bool IsProcedure(const Expr<SomeType> &expr) {
+bool IsProcedureDesignator(const Expr<SomeType> &expr) {
   return std::holds_alternative<ProcedureDesignator>(expr.u);
 }
-bool IsFunction(const Expr<SomeType> &expr) {
+bool IsFunctionDesignator(const Expr<SomeType> &expr) {
   const auto *designator{std::get_if<ProcedureDesignator>(&expr.u)};
   return designator && designator->GetType().has_value();
 }
@@ -847,6 +847,10 @@ bool IsProcedurePointer(const Expr<SomeType> &expr) {
   }
 }
 
+bool IsProcedure(const Expr<SomeType> &expr) {
+  return IsProcedureDesignator(expr) || IsProcedurePointer(expr);
+}
+
 bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
   return common::visit(common::visitors{
                            [](const NullPointer &) { return true; },

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
@@ -3761,7 +3761,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
 
-    if (!lowerToHighLevelFIR() && Fortran::evaluate::IsProcedure(assign.rhs))
+    if (!lowerToHighLevelFIR() &&
+        Fortran::evaluate::IsProcedureDesignator(assign.rhs))
       TODO(loc, "procedure pointer assignment");
     if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
       hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(

diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
@@ -387,7 +387,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
       // nothing to do; rely on zero initialization
       return true;
     } else if (isProcPointer) {
-      if (evaluate::IsProcedure(*expr)) {
+      if (evaluate::IsProcedureDesignator(*expr)) {
         if (CheckPointerAssignment(exprAnalyzer_.context(), designator, *expr,
                 scope,
                 /*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) {
@@ -419,7 +419,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
   } else if (evaluate::IsNullPointer(*expr)) {
     exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US,
         DescribeElement());
-  } else if (evaluate::IsProcedure(*expr)) {
+  } else if (evaluate::IsProcedureDesignator(*expr)) {
     exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US,
         DescribeElement());
   } else if (auto designatorType{designator.GetType()}) {

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
@@ -4608,14 +4608,15 @@ std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
     context_.SayAt(expr.source,
         "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
   } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) {
-    if (isProcedureCall_ || !IsProcedure(*argExpr)) {
+    if (isProcedureCall_ || !IsProcedureDesignator(*argExpr)) {
       ActualArgument arg{std::move(*argExpr)};
       SetArgSourceLocation(arg, expr.source);
       return std::move(arg);
     }
     context_.SayAt(expr.source,
-        IsFunction(*argExpr) ? "Function call must have argument list"_err_en_US
-                             : "Subroutine name is not allowed here"_err_en_US);
+        IsFunctionDesignator(*argExpr)
+            ? "Function call must have argument list"_err_en_US
+            : "Subroutine name is not allowed here"_err_en_US);
   }
   return std::nullopt;
 }

diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
@@ -153,3 +153,10 @@ subroutine s10
   !ERROR: Actual argument for 'a=' may not be a procedure
   print *, abs(a10)
 end
+
+subroutine s11
+  real, pointer :: p(:)
+  !ERROR: Actual argument for 'a=' may not be NULL()
+  print *, rank(null())
+  print *, rank(null(mold=p)) ! ok
+end