[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
  ```

Author: DanielCChen

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);

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);

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