Skip to content

[Flang] Support for passing procedure pointer, reference to a function that returns a procedure pointer to structure constructor. #86533

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Mar 26, 2024
Merged

[Flang] Support for passing procedure pointer, reference to a function that returns a procedure pointer to structure constructor. #86533

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b16110f
[Flang] Support for passing procedure pointer, reference to a functio…
DanielCChen Mar 25, 2024
155a3c4
[Flang] Need to handle NULL() case.
DanielCChen Mar 25, 2024
6d0b6f3
[Flang] Avoid getting shape from a procedure pointer components.
DanielCChen Mar 25, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion flang/lib/Lower/Bridge.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3490,7 +3490,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
assign.rhs)) {
// rhs is null(). rhs being null(pptr) is handled in genNull.
auto boxTy{Fortran::lower::getUntypedBoxProcType(&getMLIRContext())};
auto boxTy{
Fortran::lower::getUntypedBoxProcType(builder->getContext())};
hlfir::Entity rhs(
fir::factory::createNullBoxProc(*builder, loc, boxTy));
builder->createStoreWithConvert(loc, rhs, lhs);
Expand Down
21 changes: 18 additions & 3 deletions flang/lib/Lower/ConvertExprToHLFIR.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -130,7 +130,8 @@ class HlfirDesignatorBuilder {
// shape is deferred and should not be loaded now to preserve
// pointer/allocatable aspects.
if (componentSym.Rank() == 0 ||
Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym))
Fortran::semantics::IsAllocatableOrObjectPointer(&componentSym) ||
Fortran::semantics::IsProcedurePointer(&componentSym))
return mlir::Value{};

fir::FirOpBuilder &builder = getBuilder();
Expand Down Expand Up @@ -1767,8 +1768,22 @@ class HlfirBuilder {

if (attrs && bitEnumContainsAny(attrs.getFlags(),
fir::FortranVariableFlagsEnum::pointer)) {
if (Fortran::semantics::IsProcedure(sym))
TODO(loc, "procedure pointer component in structure constructor");
if (Fortran::semantics::IsProcedure(sym)) {
// Procedure pointer components.
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
expr)) {
auto boxTy{
Fortran::lower::getUntypedBoxProcType(builder.getContext())};
hlfir::Entity rhs(
fir::factory::createNullBoxProc(builder, loc, boxTy));
builder.createStoreWithConvert(loc, rhs, lhs);
continue;
}
hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
loc, converter, expr, symMap, stmtCtx)));
builder.createStoreWithConvert(loc, rhs, lhs);
continue;
}
// Pointer component construction is just a copy of the box contents.
fir::ExtendedValue lhsExv =
hlfir::translateToExtendedValue(loc, builder, lhs);
Expand Down
29 changes: 26 additions & 3 deletions flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
! Test passing
! 1. NULL(),
! 2. procedure,
! 3. procedure pointer, (pending)
! 4. reference to a function that returns a procedure pointer (pending)
! 3. procedure pointer,
! 4. reference to a function that returns a procedure pointer.
! to a derived type structure constructor.
! RUN: bbc -emit-hlfir -o - %s | FileCheck %s

Expand All @@ -25,10 +25,33 @@ PROGRAM MAIN
IMPLICIT NONE
TYPE (DT), PARAMETER :: v1 = DT(NULL())
TYPE (DT) :: v2
PROCEDURE(FUN), POINTER :: pp2
v2 = DT(fun)
v2 = DT(pp2)
v2 = DT(bar())
CONTAINS
FUNCTION BAR() RESULT(res)
PROCEDURE(FUN), POINTER :: res
END
END

! CDHECK-LABEL: fir.global internal @_QFECv1 constant : !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}> {
! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "main"} {
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> i32> {bindc_name = "pp2", uniq_name = "_QFEpp2"}
! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFEpp2"} : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>, !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>)
! CHECK: %[[VAL_17:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>) -> (!fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>, !fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>)
! CHECK: %[[VAL_23:.*]] = hlfir.designate %[[VAL_17]]#0{"pp1"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>
! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>
! CHECK: fir.store %[[VAL_24]] to %[[VAL_23]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>
! CHECK: %[[VAL_25:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>) -> (!fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>, !fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>)
! CHECK: %[[VAL_31:.*]] = hlfir.designate %[[VAL_25]]#0{"pp1"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>
! CHECK: %[[VAL_32:.*]] = fir.call @_QFPbar() fastmath<contract> : () -> !fir.boxproc<(!fir.ref<i32>) -> i32>
! CHECK: fir.store %[[VAL_32]] to %[[VAL_31]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> i32>>
! CHECK: return
! CHECK: }

! CHECK-LABEL: fir.global internal @_QFECv1 constant : !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}> {
! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
! CHECK: %[[VAL_1:.*]] = fir.field_index pp1, !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
! CHECK: %[[VAL_2:.*]] = fir.zero_bits (!fir.ref<i32>) -> i32
Expand Down