[flang-commits] [flang] 09b4649 - [flang] Fix passing NULL to OPTIONAL procedure pointers (#80267)
via flang-commits
flang-commits at lists.llvm.org
Thu Feb 1 08:43:47 PST 2024
Author: jeanPerier
Date: 2024-02-01T17:43:43+01:00
New Revision: 09b4649ea5cefc4f93d9c936d38863df5c6568ed
URL: https://github.com/llvm/llvm-project/commit/09b4649ea5cefc4f93d9c936d38863df5c6568ed
DIFF: https://github.com/llvm/llvm-project/commit/09b4649ea5cefc4f93d9c936d38863df5c6568ed.diff
LOG: [flang] Fix passing NULL to OPTIONAL procedure pointers (#80267)
Procedure pointer lowering used `prepareUserCallActualArgument` because
it was convenient, but this helper was not meant for POINTERs when
originally written and it did not handled passing NULL to an OPTIONAL
procedure pointer correctly.
The resulting argument should be a disassociated pointer, not an absent
pointer (Fortran 15.5.2.12 point 1.).
Move the logic for procedure pointer argument "cooking" in its own
helper to avoid triggering the logic that created an absent argument in
this case.
Added:
Modified:
flang/lib/Lower/ConvertCall.cpp
flang/test/Lower/HLFIR/procedure-pointer.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 1d5ebeb1b3620..bb8fd2e945f43 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -912,37 +912,16 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
// element if this is an array in an elemental call.
hlfir::Entity actual = preparedActual.getActual(loc, builder);
- // Handle the procedure pointer actual arguments.
- if (actual.isProcedurePointer()) {
- // Procedure pointer actual to procedure pointer dummy.
- if (fir::isBoxProcAddressType(dummyType))
- return PreparedDummyArgument{actual, /*cleanups=*/{}};
+ // Handle procedure arguments (procedure pointers should go through
+ // prepareProcedurePointerActualArgument).
+ if (hlfir::isFortranProcedureValue(dummyType)) {
// Procedure pointer actual to procedure dummy.
- if (hlfir::isFortranProcedureValue(dummyType)) {
+ if (actual.isProcedurePointer()) {
actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
return PreparedDummyArgument{actual, /*cleanups=*/{}};
}
- }
-
- // NULL() actual to procedure pointer dummy
- if (Fortran::evaluate::IsNullProcedurePointer(expr) &&
- fir::isBoxProcAddressType(dummyType)) {
- auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
- auto tempBoxProc{builder.createTemporary(loc, boxTy)};
- hlfir::Entity nullBoxProc(
- fir::factory::createNullBoxProc(builder, loc, boxTy));
- builder.create<fir::StoreOp>(loc, nullBoxProc, tempBoxProc);
- return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
- }
-
- if (actual.isProcedure()) {
- // Procedure actual to procedure pointer dummy.
- if (fir::isBoxProcAddressType(dummyType)) {
- auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
- builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
- return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
- }
// Procedure actual to procedure dummy.
+ assert(actual.isProcedure());
// Do nothing if this is a procedure argument. It is already a
// fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
if (actual.getType() != dummyType)
@@ -1219,6 +1198,34 @@ static PreparedDummyArgument prepareUserCallActualArgument(
return result;
}
+/// Prepare actual argument for a procedure pointer dummy.
+static PreparedDummyArgument prepareProcedurePointerActualArgument(
+ mlir::Location loc, fir::FirOpBuilder &builder,
+ const Fortran::lower::PreparedActualArgument &preparedActual,
+ mlir::Type dummyType,
+ const Fortran::lower::CallerInterface::PassedEntity &arg,
+ const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+
+ // NULL() actual to procedure pointer dummy
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr) &&
+ fir::isBoxProcAddressType(dummyType)) {
+ auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+ auto tempBoxProc{builder.createTemporary(loc, boxTy)};
+ hlfir::Entity nullBoxProc(
+ fir::factory::createNullBoxProc(builder, loc, boxTy));
+ builder.create<fir::StoreOp>(loc, nullBoxProc, tempBoxProc);
+ return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
+ }
+ hlfir::Entity actual = preparedActual.getActual(loc, builder);
+ if (actual.isProcedurePointer())
+ return PreparedDummyArgument{actual, /*cleanups=*/{}};
+ assert(actual.isProcedure());
+ // Procedure actual to procedure pointer dummy.
+ auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
+ builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
+ return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
+}
+
/// Lower calls to user procedures with actual arguments that have been
/// pre-lowered but not yet prepared according to the interface.
/// This can be called for elemental procedures, but only with scalar
@@ -1284,7 +1291,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
case PassBy::CharBoxValueAttribute:
case PassBy::Box:
case PassBy::BaseAddress:
- case PassBy::BoxProcRef:
case PassBy::BoxChar: {
PreparedDummyArgument preparedDummy = prepareUserCallActualArgument(
loc, builder, *preparedActual, argTy, arg, *expr, callContext);
@@ -1292,6 +1298,14 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
preparedDummy.cleanups.rend());
caller.placeInput(arg, preparedDummy.dummy);
} break;
+ case PassBy::BoxProcRef: {
+ PreparedDummyArgument preparedDummy =
+ prepareProcedurePointerActualArgument(loc, builder, *preparedActual,
+ argTy, arg, *expr, callContext);
+ callCleanUps.append(preparedDummy.cleanups.rbegin(),
+ preparedDummy.cleanups.rend());
+ caller.placeInput(arg, preparedDummy.dummy);
+ } break;
case PassBy::AddressAndLength:
// PassBy::AddressAndLength is only used for character results. Results
// are not handled here.
diff --git a/flang/test/Lower/HLFIR/procedure-pointer.f90 b/flang/test/Lower/HLFIR/procedure-pointer.f90
index ba423db150841..28965b22de971 100644
--- a/flang/test/Lower/HLFIR/procedure-pointer.f90
+++ b/flang/test/Lower/HLFIR/procedure-pointer.f90
@@ -340,6 +340,26 @@ subroutine sub12()
! CHECK: fir.call @_QPfoo2(%[[VAL_17]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
end
+subroutine test_opt_pointer()
+ interface
+ subroutine takes_opt_proc_ptr(p)
+ procedure(), pointer, optional :: p
+ end subroutine
+ end interface
+ call takes_opt_proc_ptr(NULL())
+ call takes_opt_proc_ptr()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_opt_pointer() {
+! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_1:.*]] = fir.zero_bits () -> ()
+! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK: fir.call @_QPtakes_opt_proc_ptr(%[[VAL_0]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
+! CHECK: %[[VAL_3:.*]] = fir.absent !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK: fir.call @_QPtakes_opt_proc_ptr(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
+
+
+
! CHECK-LABEL: fir.global internal @_QFsub1Ep2 : !fir.boxproc<(!fir.ref<f32>) -> f32> {
! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
More information about the flang-commits
mailing list