[flang-commits] [flang] [flang] Silence bogus error about NULL() actual for assumed-rank dummy (PR #93225)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/93225

A NULL(without MOLD=) actual argument can be associated with an OPTIONAL assumed-rank non-allocatable non-pointer dummy argument; it simply signifies that the corresponding actual argument is absent, and thus none of its dynamic attributes, including rank, are meaningful.

>From 95d4d2de36d7e3e23c2d79f661ef41d8e00d58b2 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 23 May 2024 10:40:31 -0700
Subject: [PATCH] [flang] Silence bogus error about NULL() actual for
 assumed-rank dummy

A NULL(without MOLD=) actual argument can be associated with an OPTIONAL
assumed-rank non-allocatable non-pointer dummy argument; it simply
signifies that the corresponding actual argument is absent, and
thus none of its dynamic attributes, including rank, are meaningful.
---
 flang/lib/Semantics/check-call.cpp | 21 ++++++++++++++-------
 flang/test/Semantics/call39.f90    | 23 +++++++++++++++++++----
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 8f51ef5ebeba3..2d0fb4b35a618 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1116,20 +1116,20 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
   }
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
-  auto checkActualArgForLabel = [&](evaluate::ActualArgument &arg) {
+  auto CheckActualArgForLabel = [&](evaluate::ActualArgument &arg) {
     if (arg.isAlternateReturn()) {
       messages.Say(
           "Alternate return label '%d' cannot be associated with %s"_err_en_US,
           arg.GetLabel(), dummyName);
-      return true;
-    } else {
       return false;
+    } else {
+      return true;
     }
   };
   common::visit(
       common::visitors{
           [&](const characteristics::DummyDataObject &object) {
-            if (!checkActualArgForLabel(arg)) {
+            if (CheckActualArgForLabel(arg)) {
               ConvertBOZLiteralArg(arg, object.type.type());
               if (auto *expr{arg.UnwrapExpr()}) {
                 if (auto type{characteristics::TypeAndShape::Characterize(
@@ -1147,9 +1147,16 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                     evaluate::IsNullObjectPointer(*expr)) {
                   // ok, ASSOCIATED(NULL(without MOLD=))
                 } else if (object.type.attrs().test(characteristics::
-                                   TypeAndShape::Attr::AssumedRank)) {
+                                   TypeAndShape::Attr::AssumedRank) &&
+                    evaluate::IsNullObjectPointer(*expr) &&
+                    (object.attrs.test(
+                         characteristics::DummyDataObject::Attr::Allocatable) ||
+                        object.attrs.test(
+                            characteristics::DummyDataObject::Attr::Pointer) ||
+                        !object.attrs.test(characteristics::DummyDataObject::
+                                Attr::Optional))) {
                   messages.Say(
-                      "NULL() without MOLD= must not be associated with an assumed-rank dummy argument"_err_en_US);
+                      "NULL() without MOLD= must not be associated with an assumed-rank dummy argument that is ALLOCATABLE, POINTER, or non-OPTIONAL"_err_en_US);
                 } else if ((object.attrs.test(characteristics::DummyDataObject::
                                     Attr::Pointer) ||
                                object.attrs.test(characteristics::
@@ -1210,7 +1217,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
             }
           },
           [&](const characteristics::DummyProcedure &dummy) {
-            if (!checkActualArgForLabel(arg)) {
+            if (CheckActualArgForLabel(arg)) {
               CheckProcedureArg(arg, proc, dummy, dummyName, context,
                   ignoreImplicitVsExplicit);
             }
diff --git a/flang/test/Semantics/call39.f90 b/flang/test/Semantics/call39.f90
index 41eeba1003478..724c9f9c7b7df 100644
--- a/flang/test/Semantics/call39.f90
+++ b/flang/test/Semantics/call39.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Tests actual/dummy pointer argument shape mismatches
 module m
  contains
@@ -11,6 +11,15 @@ subroutine s1(p)
   subroutine sa(p)
     real, pointer, intent(in) :: p(..)
   end
+  subroutine sao(p)
+    real, intent(in), optional, pointer :: p(..)
+  end
+  subroutine so(x)
+    real, intent(in), optional :: x(..)
+  end
+  subroutine soa(a)
+    real, intent(in), optional, allocatable :: a(..)
+  end
   subroutine test
     real, pointer :: a0, a1(:)
     call s0(null(a0)) ! ok
@@ -23,9 +32,15 @@ subroutine test
     call s1(null(a1)) ! ok
     call sa(null(a0)) ! ok
     call sa(null(a1)) ! ok
-    !ERROR: NULL() without MOLD= must not be associated with an assumed-rank dummy argument
-    call sa(null())
-    !ERROR: NULL() without MOLD= must not be associated with an assumed-rank dummy argument
+    !ERROR: NULL() without MOLD= must not be associated with an assumed-rank dummy argument that is ALLOCATABLE, POINTER, or non-OPTIONAL
     call sa(null())
+    call sao ! ok
+    !ERROR: NULL() without MOLD= must not be associated with an assumed-rank dummy argument that is ALLOCATABLE, POINTER, or non-OPTIONAL
+    call sao(null())
+    call so ! ok
+    call so(null()) ! ok
+    call soa ! ok
+    !ERROR: NULL() without MOLD= must not be associated with an assumed-rank dummy argument that is ALLOCATABLE, POINTER, or non-OPTIONAL
+    call soa(null())
   end
 end