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

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: clementval.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D155971

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


Index: flang/test/Semantics/null01.f90
===================================================================
--- flang/test/Semantics/null01.f90
+++ flang/test/Semantics/null01.f90
@@ -110,3 +110,22 @@
   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
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -909,13 +909,28 @@
                   // 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)) {


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D155971.542946.patch
Type: text/x-patch
Size: 2839 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230721/b0b4dea6/attachment-0001.bin>