[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 11:11:21 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/2] [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/2] [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);



More information about the flang-commits mailing list