[flang][hlfir] Fixed lowering for intrinsic calls with null() box argument.

Reviewed By: jeanPerier

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

5 files changed, 71 insertions, 12 deletions

diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h
index f763d29c40a1..9056f8ddd29f 100644
--- a/flang/include/flang/Optimizer/Builder/MutableBox.h
+++ b/flang/include/flang/Optimizer/Builder/MutableBox.h
@@ -168,6 +168,12 @@ mlir::Value genIsNotAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
                                               mlir::Location loc,
                                               const fir::MutableBoxValue &box);
 
+/// Generate an unallocated box of the given \p boxTy
+/// and store it into a temporary storage.
+/// Return address of the temporary storage.
+mlir::Value genNullBoxStorage(fir::FirOpBuilder &builder, mlir::Location loc,
+                              mlir::Type boxTy);
+
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index b47297811256..674e2c8c3ae9 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1137,10 +1137,8 @@ genUserCall(PreparedActualArguments &loweredActuals,
         mlir::Type boxTy = fir::dyn_cast_ptrEleTy(argTy);
         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=*/{});
-        builder.create<fir::StoreOp>(loc, nullBox, boxStorage);
+        mlir::Value boxStorage =
+            fir::factory::genNullBoxStorage(builder, loc, boxTy);
         caller.placeInput(arg, boxStorage);
         continue;
       }
@@ -1238,6 +1236,26 @@ genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
           loc, converter, actual, stmtCtx, getActualFortranElementType()));
       continue;
     case fir::LowerIntrinsicArgAs::Inquired:
+      if (const Fortran::lower::SomeExpr *expr =
+              callContext.procRef.UnwrapArgExpr(arg.index())) {
+        if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+                *expr)) {
+          // NULL() pointer without a MOLD must be passed as a deallocated
+          // pointer (see table 16.5 in Fortran 2018 standard).
+          // !fir.box<!fir.ptr<none>> should always be valid in this context.
+          mlir::Type noneTy = mlir::NoneType::get(builder.getContext());
+          mlir::Type nullPtrTy = fir::PointerType::get(noneTy);
+          mlir::Type boxTy = fir::BoxType::get(nullPtrTy);
+          mlir::Value boxStorage =
+              fir::factory::genNullBoxStorage(builder, loc, boxTy);
+          hlfir::EntityWithAttributes nullBoxEntity =
+              extendedValueToHlfirEntity(loc, builder, boxStorage,
+                                         ".tmp.null_box");
+          operands.emplace_back(Fortran::lower::translateToExtendedValue(
+              loc, builder, nullBoxEntity, stmtCtx));
+          continue;
+        }
+      }
       // Place hlfir.expr in memory, and unbox fir.boxchar. Other entities
       // are translated to fir::ExtendedValue without transformation (notably,
       // pointers/allocatable are not dereferenced).
@@ -1258,8 +1276,8 @@ genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
     scalarResultType = hlfir::getFortranElementType(*callContext.resultType);
   const std::string intrinsicName = callContext.getProcedureName();
   // Let the intrinsic library lower the intrinsic procedure call.
-  auto [resultExv, mustBeFreed] = genIntrinsicCall(
-      callContext.getBuilder(), loc, intrinsicName, scalarResultType, operands);
+  auto [resultExv, mustBeFreed] =
+      genIntrinsicCall(builder, loc, intrinsicName, scalarResultType, operands);
   if (!fir::getBase(resultExv))
     return std::nullopt;
   hlfir::EntityWithAttributes resultEntity = extendedValueToHlfirEntity(
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 2534f4ee6785..47d5ed4c02e5 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -720,11 +720,8 @@ public:
     mlir::Type noneTy = mlir::NoneType::get(builder.getContext());
     mlir::Type polyRefTy = fir::PointerType::get(noneTy);
     mlir::Type boxType = fir::BoxType::get(polyRefTy);
-    mlir::Value nullConst = builder.createNullConstant(loc, polyRefTy);
     mlir::Value tempBox =
-        builder.createTemporary(loc, boxType, /*shape=*/mlir::ValueRange{});
-    mlir::Value nullBox = builder.create<fir::EmboxOp>(loc, boxType, nullConst);
-    builder.create<fir::StoreOp>(loc, nullBox, tempBox);
+        fir::factory::genNullBoxStorage(builder, loc, boxType);
     return fir::MutableBoxValue(tempBox,
                                 /*lenParameters=*/mlir::ValueRange{},
                                 /*mutableProperties=*/{});
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index 3c4169643e48..a673c441b25b 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -934,3 +934,13 @@ void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder,
                                            const fir::MutableBoxValue &box) {
   MutablePropertyWriter{builder, loc, box}.syncMutablePropertiesFromIRBox();
 }
+
+mlir::Value fir::factory::genNullBoxStorage(fir::FirOpBuilder &builder,
+                                            mlir::Location loc,
+                                            mlir::Type boxTy) {
+  mlir::Value boxStorage = builder.createTemporary(loc, boxTy);
+  mlir::Value nullBox = fir::factory::createUnallocatedBox(
+      builder, loc, boxTy, /*nonDeferredParams=*/{});
+  builder.create<fir::StoreOp>(loc, nullBox, boxStorage);
+  return boxStorage;
+}
diff --git a/flang/test/Lower/HLFIR/null.f90 b/flang/test/Lower/HLFIR/null.f90
index 6ae44082f316..985b8146fa11 100644
--- a/flang/test/Lower/HLFIR/null.f90
+++ b/flang/test/Lower/HLFIR/null.f90
@@ -1,6 +1,6 @@
 ! Test lowering of NULL(MOLD) to HLFIR.
 ! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
-subroutine test(mold)
+subroutine test1(mold)
   integer, pointer :: mold(:)
   interface
     subroutine takes_ptr(p)
@@ -9,7 +9,7 @@ subroutine test(mold)
   end interface
   call takes_ptr(null(mold))
 end subroutine
-! CHECK-LABEL:   func.func @_QPtest(
+! CHECK-LABEL:   func.func @_QPtest1(
 ! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
 ! CHECK:  %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
@@ -18,3 +18,31 @@ end subroutine
 ! CHECK:  fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
 ! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
 ! CHECK:  fir.call @_QPtakes_ptr(%[[VAL_7]]#0) fastmath<contract> : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> ()
+
+subroutine test2
+  integer, pointer :: i
+  logical :: l
+  l = associated(null(),i)
+end subroutine test2
+! CHECK-LABEL:   func.func @_QPtest2() {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<none>>
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = "i", uniq_name = "_QFtest2Ei"}
+! CHECK:           %[[VAL_2:.*]] = fir.zero_bits !fir.ptr<i32>
+! CHECK:           %[[VAL_3:.*]] = fir.embox %[[VAL_2]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK:           fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest2Ei"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
+! CHECK:           %[[VAL_5:.*]] = fir.alloca !fir.logical<4> {bindc_name = "l", uniq_name = "_QFtest2El"}
+! CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {uniq_name = "_QFtest2El"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+! CHECK:           %[[VAL_7:.*]] = fir.zero_bits !fir.ptr<none>
+! CHECK:           %[[VAL_8:.*]] = fir.embox %[[VAL_7]] : (!fir.ptr<none>) -> !fir.box<!fir.ptr<none>>
+! CHECK:           fir.store %[[VAL_8]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<none>>>
+! CHECK:           %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = ".tmp.null_box"} : (!fir.ref<!fir.box<!fir.ptr<none>>>) -> (!fir.ref<!fir.box<!fir.ptr<none>>>, !fir.ref<!fir.box<!fir.ptr<none>>>)
+! CHECK:           %[[VAL_10:.*]] = fir.load %[[VAL_4]]#1 : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_11:.*]] = fir.load %[[VAL_9]]#1 : !fir.ref<!fir.box<!fir.ptr<none>>>
+! CHECK:           %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.ptr<none>>) -> !fir.box<none>
+! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.ptr<i32>>) -> !fir.box<none>
+! CHECK:           %[[VAL_14:.*]] = fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_12]], %[[VAL_13]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>) -> i1
+! CHECK:           %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i1) -> !fir.logical<4>
+! CHECK:           hlfir.assign %[[VAL_15]] to %[[VAL_6]]#0 : !fir.logical<4>, !fir.ref<!fir.logical<4>>
+! CHECK:           return
+! CHECK:         }