[flang-commits] [flang] [Flang] Support for passing procedure pointer, reference to a function that returns a procedure pointer to structure constructor. (PR #86533)
Daniel Chen via flang-commits
flang-commits at lists.llvm.org
Mon Mar 25 12:42:04 PDT 2024
https://github.com/DanielCChen updated https://github.com/llvm/llvm-project/pull/86533
>From b16110f4130f172c29f47ee62c6e018f6ff34445 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Mon, 25 Mar 2024 13:07:48 -0400
Subject: [PATCH 1/3] [Flang] Support for passing procedure pointer, reference
to a function that returns a procedure pointer to structure constructor.
---
flang/lib/Lower/ConvertExprToHLFIR.cpp | 8 +++--
...ointer-component-structure-constructor.f90 | 29 +++++++++++++++++--
2 files changed, 32 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index fe5ce4b17b2587..b6bdf1b26a3407 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1767,8 +1767,12 @@ 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)) {
+ 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);
diff --git a/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90 b/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
index f41c832ee5ec6a..7b64634d10d4b0 100644
--- a/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
+++ b/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
@@ -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
@@ -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
>From 155a3c4ebedf8327dcde186557fb0698602c3302 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Mon, 25 Mar 2024 14:11:06 -0400
Subject: [PATCH 2/3] [Flang] Need to handle NULL() case.
---
flang/lib/Lower/Bridge.cpp | 3 ++-
flang/lib/Lower/ConvertExprToHLFIR.cpp | 10 ++++++++++
2 files changed, 12 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 0b54ee818e3cd9..39acd306153104 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -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);
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index b6bdf1b26a3407..2e0ffe5ac9bfa3 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1768,6 +1768,16 @@ class HlfirBuilder {
if (attrs && bitEnumContainsAny(attrs.getFlags(),
fir::FortranVariableFlagsEnum::pointer)) {
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);
>From 6d0b6f306b5efdc5c9648ca833b81f091de64d58 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Mon, 25 Mar 2024 15:35:14 -0400
Subject: [PATCH 3/3] [Flang] Avoid getting shape from a procedure pointer
components.
---
flang/lib/Lower/ConvertExprToHLFIR.cpp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 2e0ffe5ac9bfa3..6e57b31d022b0b 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -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();
More information about the flang-commits
mailing list