[flang-commits] [flang] 8ceba59 - [flang] Ensure that NULL(without MOLD=) not passed to dummy argument with assumed type parameters

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-07-21T14:13:16-07:00
New Revision: 8ceba5980c45a7819186bfd699ba3723b9f8b6a0

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

LOG: [flang] Ensure that NULL(without MOLD=) not passed to dummy argument with assumed type parameters

A dummy argument with an assumed (*) character length or derived type parameter
value specification needs to be associated with an actual argument that can
supply a value for it, so make sure that a NULL without a MOLD= is not being
passed.

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

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 3c7b18ee113a16..af5a6e986dd862 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -909,13 +909,28 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                   // ok
                 } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                     evaluate::IsNullObjectPointer(*expr)) {
-                  // ok, ASSOCIATED(NULL())
+                  // ok, ASSOCIATED(NULL(without MOLD=))
                 } else if ((object.attrs.test(characteristics::DummyDataObject::
                                     Attr::Pointer) ||
                                object.attrs.test(characteristics::
                                        DummyDataObject::Attr::Optional)) &&
                     evaluate::IsNullObjectPointer(*expr)) {
-                  // ok, FOO(NULL())
+                  // FOO(NULL(without MOLD=))
+                  if (object.type.type().IsAssumedLengthCharacter()) {
+                    messages.Say(
+                        "Actual argument associated with %s is a NULL() pointer without a MOLD= to provide a character length"_err_en_US,
+                        dummyName);
+                  } else if (const DerivedTypeSpec *
+                      derived{GetDerivedTypeSpec(object.type.type())}) {
+                    for (const auto &[pName, pValue] : derived->parameters()) {
+                      if (pValue.isAssumed()) {
+                        messages.Say(
+                            "Actual argument associated with %s is a NULL() pointer without a MOLD= to provide a value for the assumed type parameter '%s'"_err_en_US,
+                            dummyName, pName.ToString());
+                        break;
+                      }
+                    }
+                  }
                 } else if (object.attrs.test(characteristics::DummyDataObject::
                                    Attr::Allocatable) &&
                     evaluate::IsNullPointer(*expr)) {

diff  --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90
index e2e16fafa140a6..c56701004f77a8 100644
--- a/flang/test/Semantics/null01.f90
+++ b/flang/test/Semantics/null01.f90
@@ -110,3 +110,22 @@ function f3()
   if (null(lp)) then
   end if
 end subroutine test
+
+module m
+  type :: pdt(n)
+    integer, len :: n
+  end type
+ contains
+  subroutine s1(x)
+    character(*), pointer, intent(in) :: x
+  end
+  subroutine s2(x)
+    type(pdt(*)), pointer, intent(in) :: x
+  end
+  subroutine test
+    !ERROR: Actual argument associated with dummy argument 'x=' is a NULL() pointer without a MOLD= to provide a character length
+    call s1(null())
+    !ERROR: Actual argument associated with dummy argument 'x=' is a NULL() pointer without a MOLD= to provide a value for the assumed type parameter 'n'
+    call s2(null())
+  end
+end