From fdce1b7ed3a625e32ec18d0f0caecd733f95b704 Mon Sep 17 00:00:00 2001
From: Slava Zakharin <szakharin@nvidia.com>
Date: Mon, 8 May 2023 19:34:21 -0700
Subject: [flang][hlfir] Allow passing null() to dummy class argument.

---
 flang/lib/Lower/ConvertCall.cpp              |  3 ++-
 flang/test/Lower/pass-null-for-class-arg.f90 | 31 ++++++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Lower/pass-null-for-class-arg.f90

(limited to 'flang')

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 35e34511d542..9111263db301 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1135,7 +1135,8 @@ genUserCall(PreparedActualArguments &loweredActuals,
         // callee side, and it is illegal to use NULL without a MOLD if any
         // dummy length parameters are assumed.
         mlir::Type boxTy = fir::dyn_cast_ptrEleTy(argTy);
-        assert(boxTy && boxTy.isa<fir::BoxType>() && "must be a fir.box type");
+        assert(boxTy && boxTy.isa<fir::BaseBoxType>() &&
+               "must be a fir.box type");
         mlir::Value boxStorage = builder.createTemporary(loc, boxTy);
         mlir::Value nullBox = fir::factory::createUnallocatedBox(
             builder, loc, boxTy, /*nonDeferredParams=*/{});
diff --git a/flang/test/Lower/pass-null-for-class-arg.f90 b/flang/test/Lower/pass-null-for-class-arg.f90
new file mode 100644
index 000000000000..d3d657f29a36
--- /dev/null
+++ b/flang/test/Lower/pass-null-for-class-arg.f90
@@ -0,0 +1,31 @@
+! RUN: bbc -emit-fir -polymorphic-type %s -o - | FileCheck %s --check-prefix=FIR
+! RUN: bbc -emit-fir -polymorphic-type -hlfir %s -o - | FileCheck %s --check-prefix=HLFIR
+
+subroutine test
+  interface
+     subroutine s1p(n)
+       type t
+          integer :: n
+       end type t
+       class(t), pointer :: n
+     end subroutine s1p
+  end interface
+  call s1p(null())
+end subroutine test
+! FIR-LABEL:   func.func @_QPtest() {
+! FIR:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>
+! FIR:           %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>
+! FIR:           %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>) -> !fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>
+! FIR:           fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>>
+! FIR:           fir.call @_QPs1p(%[[VAL_0]]) fastmath<contract> : (!fir.ref<!fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>>) -> ()
+! FIR:           return
+! FIR:         }
+
+! HLFIR-LABEL:   func.func @_QPtest() {
+! HLFIR:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>
+! HLFIR:           %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>
+! HLFIR:           %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>) -> !fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>
+! HLFIR:           fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>>
+! HLFIR:           fir.call @_QPs1p(%[[VAL_0]]) fastmath<contract> : (!fir.ref<!fir.class<!fir.ptr<!fir.type<_QFtestFs1pTt{n:i32}>>>>) -> ()
+! HLFIR:           return
+! HLFIR:         }
-- 
cgit v1.2.1