shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity

[flang] Fix passing NULL to OPTIONAL procedure pointers (#80267)

Browse Source 
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.
This commit is contained in:
jeanPerier 2024-02-01 17:43:43 +01:00 committed by GitHub
parent 4eb0810922
commit 09b4649ea5
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 61 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
flang/lib/Lower/ConvertCall.cpp
View File

@ -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.

20
flang/test/Lower/HLFIR/procedure-pointer.f90
View File

@ -340,6 +340,26 @@ use m
! 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>