[flang-commits] [flang] b76e08d - [flang] Accept NULL() actual for optional allocatable dummy argument (#66251)

[via flang-commits]

Author: Peter Klausler
Date: 2023-09-18T11:54:27-07:00
New Revision: b76e08db9c14741850a366da7bbe3c80ad50e456

URL: https://github.com/llvm/llvm-project/commit/b76e08db9c14741850a366da7bbe3c80ad50e456
DIFF: https://github.com/llvm/llvm-project/commit/b76e08db9c14741850a366da7bbe3c80ad50e456.diff

LOG: [flang] Accept NULL() actual for optional allocatable dummy argument (#66251)

A NULL() pointer is an acceptable actual argument for association with
an (absent) optional allocatable dummy argument. Semantics was
unconditionally emitting an error that the actual argument is not
allocatable.

Added: 
    

Modified: 
    flang/lib/Semantics/check-call.cpp
    flang/test/Semantics/null01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ef05b2ab61e8bcd..428c29b9a6bced7 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -657,8 +657,11 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
 
   // 15.5.2.6 -- dummy is ALLOCATABLE
   bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
+  bool dummyIsOptional{
+      dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
+  bool actualIsNull{evaluate::IsNullPointer(actual)};
   if (dummyIsAllocatable) {
-    if (!actualIsAllocatable) {
+    if (!actualIsAllocatable && !(actualIsNull && dummyIsOptional)) {
       messages.Say(
           "ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US,
           dummyName);
@@ -788,9 +791,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   }
 
   // NULL(MOLD=) checking for non-intrinsic procedures
-  bool dummyIsOptional{
-      dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
-  bool actualIsNull{evaluate::IsNullPointer(actual)};
   if (!intrinsic && !dummyIsPointer && !dummyIsOptional && actualIsNull) {
     messages.Say(
         "Actual argument associated with %s may not be null pointer %s"_err_en_US,

diff  --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90
index 02a68147a7527ad..71567fb0a673465 100644
--- a/flang/test/Semantics/null01.f90
+++ b/flang/test/Semantics/null01.f90
@@ -12,6 +12,9 @@ subroutine canbenull(x, y)
       integer, intent(in), optional :: x
       real, intent(in), pointer :: y
     end
+    subroutine optionalAllocatable(x)
+      integer, intent(in), allocatable, optional :: x
+    end
     function f0()
       real :: f0
     end function
@@ -95,6 +98,7 @@ function f3()
   dt4x = dt4(null(dt2x%pps0))
   call canbenull(null(), null()) ! fine
   call canbenull(null(mold=ip0), null(mold=rp0)) ! fine
+  call optionalAllocatable(null(mold=ip0)) ! fine
   !ERROR: Null pointer argument requires an explicit interface
   call implicit(null())
   !ERROR: Null pointer argument requires an explicit interface