[flang-commits] [flang] 9a20612 - [flang] NULL(NULL(NULL(...(NULL()...))) means NULL() (#83738)

[via flang-commits]

Author: Peter Klausler
Date: 2024-03-05T11:09:48-08:00
New Revision: 9a20612d960bbcbf6bd59d2d94400574a3cccde0

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

LOG: [flang] NULL(NULL(NULL(...(NULL()...))) means NULL() (#83738)

When the actual MOLD= argument of a reference to the intrinsic function
NULL is itself just NULL() (possibly nested), treat the MOLD= as if it
had not been present.

Fixes https://github.com/llvm/llvm-project/issues/83572.

Added: 
    

Modified: 
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/null01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index a8f2e5b445ed2b..9b98d22cc58e53 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2635,19 +2635,30 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
   static const char *const keywords[]{"mold", nullptr};
   if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1) &&
       arguments[0]) {
-    if (Expr<SomeType> * mold{arguments[0]->UnwrapExpr()}) {
-      bool isProcPtrTarget{IsProcedurePointerTarget(*mold)};
+    Expr<SomeType> *mold{arguments[0]->UnwrapExpr()};
+    bool isBareNull{IsBareNullPointer(mold)};
+    if (isBareNull) {
+      // NULL(NULL()), NULL(NULL(NULL())), &c. are all just NULL()
+      mold = nullptr;
+    }
+    if (mold) {
+      bool isProcPtrTarget{
+          IsProcedurePointerTarget(*mold) && !IsNullObjectPointer(*mold)};
       if (isProcPtrTarget || IsAllocatableOrPointerObject(*mold)) {
         characteristics::DummyArguments args;
         std::optional<characteristics::FunctionResult> fResult;
         if (isProcPtrTarget) {
           // MOLD= procedure pointer
-          const Symbol *last{GetLastSymbol(*mold)};
-          CHECK(last);
-          auto procPointer{IsProcedure(*last)
-                  ? characteristics::Procedure::Characterize(*last, context)
-                  : std::nullopt};
-          // procPointer is null if there was an error with the analysis
+          std::optional<characteristics::Procedure> procPointer;
+          if (IsNullProcedurePointer(*mold)) {
+            procPointer =
+                characteristics::Procedure::Characterize(*mold, context);
+          } else {
+            const Symbol *last{GetLastSymbol(*mold)};
+            procPointer =
+                characteristics::Procedure::Characterize(DEREF(last), context);
+          }
+          // procPointer is vacant if there was an error with the analysis
           // associated with the procedure pointer
           if (procPointer) {
             args.emplace_back("mold"s,
@@ -2676,8 +2687,10 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
         }
       }
     }
-    context.messages().Say(arguments[0]->sourceLocation(),
-        "MOLD= argument to NULL() must be a pointer or allocatable"_err_en_US);
+    if (!isBareNull) {
+      context.messages().Say(arguments[0]->sourceLocation(),
+          "MOLD= argument to NULL() must be a pointer or allocatable"_err_en_US);
+    }
   }
   characteristics::Procedure::Attrs attrs;
   attrs.set(characteristics::Procedure::Attr::NullPointer);

diff  --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90
index 71567fb0a67346..b61d464d0e7cee 100644
--- a/flang/test/Semantics/null01.f90
+++ b/flang/test/Semantics/null01.f90
@@ -65,12 +65,22 @@ function f3()
   real(kind=eight) :: r8check
   logical, pointer :: lp
   ip0 => null() ! ok
+  ip0 => null(null()) ! ok
+  ip0 => null(null(null())) ! ok
   ip1 => null() ! ok
+  ip1 => null(null()) ! ok
+  ip1 => null(null(null())) ! ok
   ip2 => null() ! ok
+  ip2 => null(null()) ! ok
+  ip2 => null(null(null())) ! ok
   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
   ip0 => null(mold=1)
   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
+  ip0 => null(null(mold=1))
+  !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
   ip0 => null(mold=j)
+  !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
+  ip0 => null(mold=null(mold=j))
   dt0x = dt0(null())
   dt0x = dt0(ip0=null())
   dt0x = dt0(ip0=null(ip0))