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

[vzakhari]

flang/lib/Lower/ConvertCall.cpp

1245

I wonder if we need to do the same for the NullPointer lowering in ConvertExprToHLFIR.cpp. Then this code here won't be needed.

[jeanPerier]

LGTM, thanks!

flang/lib/Lower/ConvertCall.cpp

1245

It is not possible to move this for NullPointer in ConvertExprToHLFIR.cpp because this has memory operations (store/alloca), and the NullPointer code in ConvertExprToHLFIR is required in to generate code inside global initializer to deal with C_PTR NullPointer initializer, which appears in compiler generated derived type descriptor symbols.

See for instance when generating code for:

subroutine foo(x)
type t
  integer :: i
end type
  type(t) :: x
end subroutine

There are NULLs() in:

.c.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.i,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]

So I think this is the right place to deal with this. Beside, as stated in table 16.5, the NULL() appearance here technically takes the "Type, type parameters, and rank" of "the corresponding dummy argument". Technically, we should query here the type and rank from the characteristic and create a fir.box with that.

But in the case of ASSOCIATED that you are fixing here, there is not really any type and rank info for "POINTER"... The arguments are Assumed Type/Assumed Rank since they can be of any type and rank, so there is an infinite loop (Dummy is assumed and takes type and rank from actual, actual is NULL and takes type and ranks from actual)^^. Anyway, my understanding is that ASSOCIATED(NULL(), xx) and ASSOCIATED(xx, NULL()) are false and that the runtime just needs the pointer/target base address to be null to correctly deduce that.

So creating a fir.box<!fir.ptr<None>> is the best we can do I think. I looked at the 11 other cases where "asInquired" is used, and I do not think NULL() would be allowed in any of them. So your code is fine. However, I would rather keep it here in case we need context specific information at some point from the dummy argument to create the null box for some new intrinsic.

[vzakhari]

flang/lib/Lower/ConvertCall.cpp

1245

Oh, I see. I missed the point that NullPointer in some contexts is just a nullptr constant. Thanks for the example!

flang/include/flang/Optimizer/Builder/MutableBox.h

mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
                                            const fir::MutableBoxValue &box);
 
 /// Generate allocation or association status test and returns the resulting
 /// i1. This is testing this for a valid/non-null base address value.
 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

flang/lib/Lower/ConvertCall.cpp

case PassBy::MutableBox: {
         // in Fortran 2018 standard).
         // No length parameters are set for the created box because any non
         // deferred type parameters of the dummy will be evaluated on the
         // 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::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;
       }
       if (fir::isPointerType(argTy) &&
           !Fortran::evaluate::IsObjectPointer(
               *expr, callContext.converter.getFoldingContext())) {
         // Passing a non POINTER actual argument to a POINTER dummy argument.
         // Create a pointer of the dummy argument type and assign the actual
case fir::LowerIntrinsicArgAs::Addr:
       operands.emplace_back(Fortran::lower::convertToAddress(
           loc, converter, actual, stmtCtx, getActualFortranElementType()));
       continue;
     case fir::LowerIntrinsicArgAs::Box:
       operands.emplace_back(Fortran::lower::convertToBox(
           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).
       // TODO: once lowering to FIR retires, UBOUND and LBOUND can be simplified
       // since the fir.box lowered here are now guaranteed to contain the local
       // lower bounds thanks to the hlfir.declare (the extra rebox can be
       // removed).
       operands.emplace_back(Fortran::lower::translateToExtendedValue(
           loc, builder, actual, stmtCtx));
       continue;
     }
     llvm_unreachable("bad switch");
   }
   // genIntrinsicCall needs the scalar type, even if this is a transformational
   // procedure returning an array.
   std::optional<mlir::Type> scalarResultType;
   if (callContext.resultType)
     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(
       loc, builder, resultExv, ".tmp.intrinsic_result");
   // Move result into memory into an hlfir.expr since they are immutable from
   // that point, and the result storage is some temp. "Null" is special: it
   // returns a null pointer variable that should not be transformed into a value
   // (what matters is the memory address).

flang/lib/Lower/ConvertExpr.cpp

public:
   /// be depreciated because the rank information is not known here. A
   /// scalar fir.box is created: it should not be cast to an array box type
   /// later, but there is no way to enforce that here.
   ExtValue genMutableBoxValueImpl(const Fortran::evaluate::NullPointer &) {
     mlir::Location loc = getLoc();
     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=*/{});
   }
 
   template <typename T>
   ExtValue
   genMutableBoxValueImpl(const Fortran::evaluate::FunctionRef<T> &funRef) {

flang/lib/Optimizer/Builder/MutableBox.cpp

mlir::Value fir::factory::getMutableIRBox(fir::FirOpBuilder &builder,
   MutablePropertyWriter{builder, loc, box}.syncIRBoxFromMutableProperties();
   return box.getAddr();
 }
 void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            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;
+}

flang/test/Lower/HLFIR/null.f90

 ! 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)
       integer, pointer :: p(:)
     end subroutine
   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
 ! CHECK:  %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
 ! CHECK:  %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
 ! 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:         }