Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 21, 2024

Conversation

DanielCChen
Copy link
Contributor

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.

@DanielCChen DanielCChen requested a review from jeanPerier March 20, 2024 19:17
@DanielCChen DanielCChen self-assigned this Mar 20, 2024
@llvmbot llvmbot added the flang Flang issues not falling into any other category label Mar 20, 2024
@llvmbot
Copy link
Member

llvmbot commented Mar 20, 2024

@llvm/pr-subscribers-flang-fir-hlfir

Author: Daniel Chen (DanielCChen)

Changes

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.


Full diff: https://github.com/llvm/llvm-project/pull/85991.diff

2 Files Affected:

  • (modified) flang/lib/Lower/ConvertConstant.cpp (+18-4)
  • (added) flang/test/Lower/HLFIR/procedure-pointer-component-structure-constructor.f90 (+48)
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:  }

Copy link
Contributor

@jeanPerier jeanPerier left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

LGTM, thanks

@DanielCChen DanielCChen merged commit e84a985 into llvm:main Mar 21, 2024
@DanielCChen DanielCChen deleted the daniel_pptr branch March 21, 2024 17:50
@DanielCChen
Copy link
Contributor Author

Thanks for the quick review!

chencha3 pushed a commit to chencha3/llvm-project that referenced this pull request Mar 23, 2024
… procedure pointer component. (llvm#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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:fir-hlfir flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

3 participants