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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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.

>From 2aa0594b0a8aa34d85394b841e20afb9d4658c42 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Sun, 3 Mar 2024 10:51:15 -0800
Subject: [PATCH] [flang] NULL(NULL(NULL(...(NULL()...))) means NULL()

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.
---
 flang/lib/Evaluate/intrinsics.cpp | 33 +++++++++++++++++++++----------
 flang/test/Semantics/null01.f90   | 10 ++++++++++
 2 files changed, 33 insertions(+), 10 deletions(-)

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))