[flang-commits] [flang] 78a166b - [flang] Allow NULL() actual argument for optional dummy procedure

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-05-09T17:41:39-07:00
New Revision: 78a166b47beb919b50594f13c1d0c23bda3e4fd7

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

LOG: [flang] Allow NULL() actual argument for optional dummy procedure

A disassociated procedure pointer is allowed to be passed as an absent
actual argument that corresponds to an optional dummy procedure,
but not NULL(); accept that case as well.

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 8f49953f4b14..fee716248cbf 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -635,7 +635,9 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
               dummyName);
         }
       } else if (IsNullPointer(*expr)) {
-        if (!dummyIsPointer) {
+        if (!dummyIsPointer &&
+            !dummy.attrs.test(
+                characteristics::DummyProcedure::Attr::Optional)) {
           messages.Say(
               "Actual argument associated with procedure %s is a null pointer"_err_en_US,
               dummyName);

diff  --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90
index dfd1ba5537d4..a4ceaf65d1ed 100644
--- a/flang/test/Semantics/call02.f90
+++ b/flang/test/Semantics/call02.f90
@@ -15,6 +15,12 @@ subroutine badsubr(dummy)
       !ERROR: A dummy procedure may not be ELEMENTAL
       procedure(elem) :: dummy
     end subroutine
+    subroutine optionalsubr(dummy)
+      procedure(sin), optional :: dummy
+    end subroutine
+    subroutine ptrsubr(dummy)
+      procedure(sin), pointer, intent(in) :: dummy
+    end subroutine
   end interface
   intrinsic :: cos
   call subr(cos) ! not an error
@@ -22,6 +28,8 @@ subroutine badsubr(dummy)
   call subr(elem) ! C1533
   !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is a null pointer
   call subr(null())
+  call optionalsubr(null()) ! ok
+  call ptrsubr(null()) ! ok
   !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is typeless
   call subr(B"1010")
 end subroutine