[flang-commits] [flang] e84a985 - [Flang] Support for NULL() and procedure in structure constructor for procedure pointer component. (#85991)

[via flang-commits]

Author: Daniel Chen
Date: 2024-03-21T13:50:40-04:00
New Revision: e84a985cbf4b26c10812e9bd339db9cfd037f581

URL: https://github.com/llvm/llvm-project/commit/e84a985cbf4b26c10812e9bd339db9cfd037f581
DIFF: https://github.com/llvm/llvm-project/commit/e84a985cbf4b26c10812e9bd339db9cfd037f581.diff

LOG: [Flang] Support for NULL() and procedure in structure constructor for procedure pointer component. (#85991)

This PR fixes a subset of procedure pointer component initialization in
structure constructor.
It covers
  1. NULL()
  2. procedure
  
 For example:
 ```
   MODULE M
    TYPE :: DT
      !PROCEDURE(Fun), POINTER, NOPASS :: pp1
      PROCEDURE(Fun), POINTER :: pp1
    END TYPE

    CONTAINS

    INTEGER FUNCTION Fun(Arg)
     class(dt) :: arg
    END FUNCTION

  END MODULE

  PROGRAM MAIN
  USE M
  IMPLICIT NONE
  TYPE (DT), PARAMETER :: v1 = DT(NULL())
  TYPE (DT) :: v2
  v2 = DT(fun)
  END
  ```
  
Passing a procedure pointer itself or reference to a function that
returns a procedure pointer is TODO.

Added: 
    flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90

Modified: 
    flang/lib/Lower/ConvertConstant.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index 336944d35b7e4a..ed389bbe4ae5ed 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -14,9 +14,12 @@
 #include "flang/Evaluate/expression.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/BuiltinModules.h"
+#include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/Mangler.h"
+#include "flang/Lower/StatementContext.h"
+#include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Todo.h"
@@ -380,10 +383,21 @@ static mlir::Value genStructureComponentInit(
   }
 
   if (Fortran::semantics::IsPointer(sym)) {
-    if (Fortran::semantics::IsProcedure(sym))
-      TODO(loc, "procedure pointer component initial value");
-    mlir::Value initialTarget =
-        Fortran::lower::genInitialDataTarget(converter, loc, componentTy, expr);
+    mlir::Value initialTarget;
+    if (Fortran::semantics::IsProcedure(sym)) {
+      if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
+        initialTarget =
+            fir::factory::createNullBoxProc(builder, loc, componentTy);
+      else {
+        Fortran::lower::SymMap globalOpSymMap;
+        Fortran::lower::StatementContext stmtCtx;
+        auto box{getBase(Fortran::lower::convertExprToAddress(
+            loc, converter, expr, globalOpSymMap, stmtCtx))};
+        initialTarget = builder.createConvert(loc, componentTy, box);
+      }
+    } else
+      initialTarget = Fortran::lower::genInitialDataTarget(converter, loc,
+                                                           componentTy, expr);
     res = builder.create<fir::InsertValueOp>(
         loc, recTy, res, initialTarget,
         builder.getArrayAttr(field.getAttributes()));

diff  --git a/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90 b/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
new file mode 100644
index 00000000000000..f41c832ee5ec6a
--- /dev/null
+++ b/flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90
@@ -0,0 +1,48 @@
+! Test passing
+!  1. NULL(),
+!  2. procedure,
+!  3. procedure pointer, (pending)
+!  4. reference to a function that returns a procedure pointer (pending)
+! to a derived type structure constructor.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+  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), PARAMETER :: v1 = DT(NULL())
+  TYPE (DT) :: v2
+  v2 = DT(fun)
+  END
+
+! CDHECK-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
+! CHECK:    %[[VAL_3:.*]] = fir.emboxproc %[[VAL_2]] : ((!fir.ref<i32>) -> i32) -> !fir.boxproc<(!fir.ref<i32>) -> i32>
+! CHECK:    %[[VAL_4:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_3]], ["pp1", !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>] : (!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>, !fir.boxproc<(!fir.ref<i32>) -> i32>) -> !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
+! CHECK:    fir.has_value %[[VAL_4]] : !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
+! CHECK:  }
+
+! CHECK-LABEL:  fir.global internal @_QQro._QMmTdt.0 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.address_of(@_QMmPfun) : (!fir.ref<i32>) -> i32
+! CHECK:    %[[VAL_3:.*]] = fir.emboxproc %[[VAL_2]] : ((!fir.ref<i32>) -> i32) -> !fir.boxproc<() -> ()>
+! CHECK:    %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> i32>
+! CHECK:    %[[VAL_5:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_4]], ["pp1", !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>] : (!fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>, !fir.boxproc<(!fir.ref<i32>) -> i32>) -> !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
+! CHECK:    fir.has_value %[[VAL_5]] : !fir.type<_QMmTdt{pp1:!fir.boxproc<(!fir.ref<i32>) -> i32>}>
+! CHECK:  }