[flang-commits] [flang] 4998587 - [Flang] Support for passing procedure pointer, reference to a function that returns a procedure pointer to structure constructor. (#86533)
via flang-commits
flang-commits at lists.llvm.org
Tue Mar 26 08:29:27 PDT 2024
Author: Daniel Chen
Date: 2024-03-26T11:29:24-04:00
New Revision: 4998587e6f5f66d464ac22ad4c11fe9afd2d56ab
URL: https://github.com/llvm/llvm-project/commit/4998587e6f5f66d464ac22ad4c11fe9afd2d56ab
DIFF: https://github.com/llvm/llvm-project/commit/4998587e6f5f66d464ac22ad4c11fe9afd2d56ab.diff
LOG: [Flang] Support for passing procedure pointer, reference to a function that returns a procedure pointer to structure constructor. (#86533)
This PR fixes `not yet implemented: procedure pointer component in
structure constructor` as shown in the following test case.
```
MODULE M
TYPE :: DT
PROCEDURE(Fun), POINTER, NOPASS :: pp1
END TYPE
CONTAINS
INTEGER FUNCTION Fun(Arg)
INTEGER :: Arg
Fun = Arg
END FUNCTION
END MODULE
PROGRAM MAIN
USE M
IMPLICIT NONE
TYPE (DT) :: v2
PROCEDURE(FUN), POINTER :: pp2
v2 = DT(pp2)
v2 = DT(bar())
CONTAINS
FUNCTION BAR() RESULT(res)
PROCEDURE(FUN), POINTER :: res
END
END
```
Added:
Modified:
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 48830dc55578c2..91b898eb513e05 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 fe5ce4b17b2587..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();
@@ -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);
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
More information about the flang-commits
mailing list