diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h index f763d29c40a11..9056f8ddd29fc 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 b472978112566..674e2c8c3ae96 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() && "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(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( + *expr)) { + // NULL() pointer without a MOLD must be passed as a deallocated + // pointer (see table 16.5 in Fortran 2018 standard). + // !fir.box> 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 2534f4ee6785d..47d5ed4c02e54 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -720,11 +720,8 @@ class ScalarExprLowering { 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(loc, boxType, nullConst); - builder.create(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 3c4169643e487..a673c441b25be 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(loc, nullBox, boxStorage); + return boxStorage; +} diff --git a/flang/test/Lower/HLFIR/null.f90 b/flang/test/Lower/HLFIR/null.f90 index 6ae44082f3164..985b8146fa11c 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 takes_ptr(p) 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>> ! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ptr> ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index @@ -18,3 +18,31 @@ subroutine takes_ptr(p) ! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref>>> ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) ! CHECK: fir.call @_QPtakes_ptr(%[[VAL_7]]#0) fastmath : (!fir.ref>>>) -> () + +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> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box> {bindc_name = "i", uniq_name = "_QFtest2Ei"} +! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_2]] : (!fir.ptr) -> !fir.box> +! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest2Ei"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) +! 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.ref>, !fir.ref>) +! CHECK: %[[VAL_7:.*]] = fir.zero_bits !fir.ptr +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_7]] : (!fir.ptr) -> !fir.box> +! CHECK: fir.store %[[VAL_8]] to %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = ".tmp.null_box"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_4]]#1 : !fir.ref>> +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_9]]#1 : !fir.ref>> +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_12]], %[[VAL_13]]) fastmath : (!fir.box, !fir.box) -> 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> +! CHECK: return +! CHECK: }