[flang-commits] [flang] 7de3c03 - [flang] Support codegen of procedure pointer component

Peixin Qiao via flang-commits flang-commits at lists.llvm.org
Wed Dec 7 05:22:57 PST 2022


Author: Peixin Qiao
Date: 2022-12-07T21:21:08+08:00
New Revision: 7de3c03e80f8017aa60f51885ec7bc163e2d7135

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

LOG: [flang] Support codegen of procedure pointer component

This supports the codegen for procedure pointer component in
BoxedProcedure pass. Also fix the FIR in ProcedurePointer.md so that
all the cases can be run using `tco` to generate the LLVM IR.

Reviewed By: jeanPerier

Differential Revision: https://reviews.llvm.org/D136842

Added: 
    

Modified: 
    flang/docs/ProcedurePointer.md
    flang/include/flang/Optimizer/Dialect/FIRTypes.td
    flang/include/flang/Optimizer/Support/InternalNames.h
    flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
    flang/lib/Optimizer/Dialect/FIRType.cpp
    flang/lib/Optimizer/Support/InternalNames.cpp
    flang/test/Fir/boxproc-2.fir

Removed: 
    


################################################################################
diff  --git a/flang/docs/ProcedurePointer.md b/flang/docs/ProcedurePointer.md
index 157d387c37094..cfa036b22fdf0 100644
--- a/flang/docs/ProcedurePointer.md
+++ b/flang/docs/ProcedurePointer.md
@@ -113,13 +113,13 @@ end subroutine proc_pointer_dummy_argument
 
 **FIR for case 1**
 ```
-func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>)
-func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>)
+func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> f32>)
+func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>)
 
-func.func @proc_pointer_dummy_argument(%0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) {
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.call @foo1(%1) : ((!fir.ref<i32>) -> !fir.ref<f32>) -> ()
-  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) -> ()
+func.func @proc_pointer_dummy_argument(%0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) {
+  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ()
+  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) -> ()
   return
 }
 ```
@@ -149,20 +149,20 @@ end subroutine proc_pointer_global
 
 **FIR for case 2**
 ```
-func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>)
-func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>)
+func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> f32>)
+func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>)
 
-fir.global internal @ProcedurePointer : !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>> {
-  %0 = fir.zero_bits (!fir.ref<i32>) -> !fir.ref<f32>
-  %1 = fir.emboxproc %0 : ((!fir.ref<i32>) -> !fir.ref<f32>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  fir.has_value %1 : !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
+fir.global internal @ProcedurePointer : !fir.boxproc<(!fir.ref<i32>) -> f32> {
+  %0 = fir.zero_bits (!fir.ref<i32>) -> f32
+  %1 = fir.emboxproc %0 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.has_value %1 : !fir.boxproc<(!fir.ref<i32>) -> f32>
 }
 
 func.func @proc_pointer_global() {
-  %0 = fir.address_of(@ProcedurePointer) : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ()
-  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) -> ()
+  %0 = fir.address_of(@ProcedurePointer) : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ()
+  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) -> ()
   return
 }
 ```
@@ -192,18 +192,17 @@ end subroutine proc_pointer_local
 
 **FIR for case 3**
 ```
-func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>)
-func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>)
+func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> f32>)
+func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>)
 
 func.func @proc_pointer_local() {
-  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  %2 = fir.box_addr %1 : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ((!fir.ref<i32>) -> !fir.ref<f32>)
-  %3 = fir.zero_bits (!fir.ref<i32>) -> !fir.ref<f32>
-  fir.store %3 to %2 : !fir.ref<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %4 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.call @foo1(%4) : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ()
-  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) -> ()
+  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %1 = fir.zero_bits (!fir.ref<i32>) -> f32
+  %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.store %2 to %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  %4 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.call @foo1(%4) : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ()
+  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) -> ()
   return
 }
 ```
@@ -344,32 +343,35 @@ end
 
 **FIR**
 ```
-func.func @Procedure(%arg0 : !fir.ref<i32>) -> !fir.ref<f32> {
+func.func @Procedure(%arg0 : !fir.ref<i32>) -> f32 {
+  %0 = fir.alloca f32 {bindc_name = "res", uniq_name = "_QFfuncEres"}
   %1 = fir.load %arg0 : !fir.ref<i32>
   %2 = fir.convert %1 : (i32) -> f32
-  return %2 : f32
+  fir.store %2 to %0 : !fir.ref<f32>
+  %3 = fir.load %0 : !fir.ref<f32>
+  return %3 : f32
 }
 
-func.func @Reference2Function() -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>> {
-  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  return %1 : !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
+func.func @Reference2Function() -> !fir.boxproc<(!fir.ref<i32>) -> f32> {
+  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  return %1 : !fir.boxproc<(!fir.ref<i32>) -> f32>
 }
 
-func.func @proc_pointer_assignment(%arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>, %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) {
-  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>> {bindc_name = ".result"}
+func.func @proc_pointer_assignment(%arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>, %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) {
+  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> f32> {bindc_name = ".result"}
   // case 1: assignment from external procedure
-  %1 = fir.address_of(@Procedure) : (!fir.ref<i32>) -> !fir.ref<f32>
-  %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> !fir.ref<f32>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  fir.store %2 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
+  %1 = fir.address_of(@Procedure) : (!fir.ref<i32>) -> f32
+  %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.store %2 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
   // case2: assignment from procdure pointer
-  %3 = fir.load %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.store %3 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
+  %3 = fir.load %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.store %3 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
   // case3: assignment from a reference to a function whose result is a procedure pointer
-  %4 = fir.call @Reference2Function() : () -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  fir.store %4 to %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  %5 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.store %5 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
+  %4 = fir.call @Reference2Function() : () -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.store %4 to %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  %5 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.store %5 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
   return
 }
 ```
@@ -402,19 +404,18 @@ end subroutine proc_pointer_component
 
 **FIR**
 ```
-func.func @proc_pointer_component(%arg0 : (!fir.ref<i32>) -> !fir.ref<f32>, %arg1: !fir.ref<i32>) {
+func.func @proc_pointer_component(%arg0 : !fir.boxproc<(!fir.ref<i32>) -> f32>, %arg1: !fir.ref<i32>) {
   %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
   %1 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
   %2 = fir.coordinate_of %0, %1 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
-  %3 = fir.emboxproc %arg0 : ((!fir.ref<i32>) -> !fir.ref<f32>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %4 = fir.convert %3 : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) ->  !fir.boxproc<() -> ()>
-  fir.store %4 to %2 : !fir.ref<!fir.boxproc<() -> ()>>
+  %3 = fir.convert %arg0 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) ->  !fir.boxproc<() -> ()>
+  fir.store %3 to %2 : !fir.ref<!fir.boxproc<() -> ()>>
   %4 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
   %5 = fir.coordinate_of %0, %4 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
   %6 = fir.load %5 : !fir.ref<!fir.boxproc<() -> ()>>
-  %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ((!fir.ref<i32>) -> !fir.ref<f32>)
-  %9 = fir.call %8(%arg1) : (!fir.ref<i32>) -> !fir.ref<f32>
+  %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ((!fir.ref<i32>) -> f32)
+  %9 = fir.call %8(%arg1) : (!fir.ref<i32>) -> f32
   return
 }
 ```
@@ -469,12 +470,11 @@ Current list of TODOs in code generation:
 
 NOTE: There are any number of possible implementations.
 
-- `flang/lib/Optimizer/CodeGen/TypeConverter.h:64` TODO: BoxProcType type conversion
-- `flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp:136` not yet implemented: record type with a boxproc type
 - fir.global for procedure pointers
 
 or
 
+- `flang/lib/Optimizer/CodeGen/TypeConverter.h:64` TODO: BoxProcType type conversion
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:2080` not yet implemented: fir.emboxproc codegen
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:629` not yet implemented: fir.boxproc_host codegen
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:1078` not yet implemented: fir.len_param_index codegen

diff  --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
index df3512915a278..4dbb61179a994 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
@@ -356,6 +356,7 @@ def fir_RecordType : FIR_Type<"Record", "type"> {
     unsigned getNumLenParams() { return getLenParamList().size(); }
     bool isDependentType() { return getNumLenParams(); }
 
+    bool isFinalized() const;
     void finalize(llvm::ArrayRef<TypePair> lenPList,
                   llvm::ArrayRef<TypePair> typeList);
 

diff  --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h
index 6defb3d567143..52bdf724be5d2 100644
--- a/flang/include/flang/Optimizer/Support/InternalNames.h
+++ b/flang/include/flang/Optimizer/Support/InternalNames.h
@@ -16,6 +16,7 @@
 
 static constexpr llvm::StringRef typeDescriptorSeparator = ".dt.";
 static constexpr llvm::StringRef bindingTableSeparator = ".v.";
+static constexpr llvm::StringRef boxprocSuffix = "UnboxProc";
 
 namespace fir {
 

diff  --git a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
index 5abb9abe55fc5..8456c4a4b14bc 100644
--- a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
+++ b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
@@ -15,6 +15,7 @@
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Optimizer/Support/FatalError.h"
+#include "flang/Optimizer/Support/InternalNames.h"
 #include "mlir/IR/PatternMatch.h"
 #include "mlir/Pass/Pass.h"
 #include "mlir/Transforms/DialectConversion.h"
@@ -125,19 +126,20 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
     addConversion([&](RecordType ty) -> mlir::Type {
       if (!needsConversion(ty))
         return ty;
-      // FIR record types can have recursive references, so conversion is a bit
-      // more complex than the other types. This conversion is not needed
-      // presently, so just emit a TODO message. Need to consider the uniqued
-      // name of the record, etc. Also, fir::RecordType::get returns the
-      // existing type being translated. So finalize() will not change it, and
-      // the translation would not do anything. So the type needs to be mutated,
-      // and this might require special care to comply with MLIR infrastructure.
-
-      // TODO: this will be needed to support derived type containing procedure
-      // pointer components.
-      fir::emitFatalError(
-          loc, "not yet implemented: record type with a boxproc type");
-      return RecordType::get(ty.getContext(), "*fixme*");
+      auto rec = RecordType::get(ty.getContext(),
+                                 ty.getName().str() + boxprocSuffix.str());
+      if (rec.isFinalized())
+        return rec;
+      std::vector<RecordType::TypePair> ps = ty.getLenParamList();
+      std::vector<RecordType::TypePair> cs;
+      for (auto t : ty.getTypeList()) {
+        if (needsConversion(t.second))
+          cs.emplace_back(t.first, convertType(t.second));
+        else
+          cs.emplace_back(t.first, t.second);
+      }
+      rec.finalize(ps, cs);
+      return rec;
     });
     addArgumentMaterialization(materializeProcedure);
     addSourceMaterialization(materializeProcedure);
@@ -322,8 +324,6 @@ class BoxedProcedurePass
         }
       });
     }
-    // TODO: any alternative implementation. Note: currently, the default code
-    // gen will not be able to handle boxproc and will give an error.
   }
 
 private:

diff  --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index af4d83c84c055..89f757585264f 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -63,11 +63,10 @@ static bool isaIntegerType(mlir::Type ty) {
 }
 
 bool verifyRecordMemberType(mlir::Type ty) {
-  return !(ty.isa<BoxCharType>() || ty.isa<BoxProcType>() ||
-           ty.isa<ShapeType>() || ty.isa<ShapeShiftType>() ||
-           ty.isa<ShiftType>() || ty.isa<SliceType>() || ty.isa<FieldType>() ||
-           ty.isa<LenType>() || ty.isa<ReferenceType>() ||
-           ty.isa<TypeDescType>());
+  return !(ty.isa<BoxCharType>() || ty.isa<ShapeType>() ||
+           ty.isa<ShapeShiftType>() || ty.isa<ShiftType>() ||
+           ty.isa<SliceType>() || ty.isa<FieldType>() || ty.isa<LenType>() ||
+           ty.isa<ReferenceType>() || ty.isa<TypeDescType>());
 }
 
 bool verifySameLists(llvm::ArrayRef<RecordType::TypePair> a1,
@@ -155,6 +154,7 @@ struct RecordTypeStorage : public mlir::TypeStorage {
   void setTypeList(llvm::ArrayRef<RecordType::TypePair> list) { types = list; }
   llvm::ArrayRef<RecordType::TypePair> getTypeList() const { return types; }
 
+  bool isFinalized() const { return finalized; }
   void finalize(llvm::ArrayRef<RecordType::TypePair> lenParamList,
                 llvm::ArrayRef<RecordType::TypePair> typeList) {
     if (finalized)
@@ -730,6 +730,8 @@ RecordType::TypeList fir::RecordType::getLenParamList() const {
   return getImpl()->getLenParamList();
 }
 
+bool fir::RecordType::isFinalized() const { return getImpl()->isFinalized(); }
+
 detail::RecordTypeStorage const *fir::RecordType::uniqueKey() const {
   return getImpl();
 }

diff  --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp
index d90866026c43f..8a12bfb69a6eb 100644
--- a/flang/lib/Optimizer/Support/InternalNames.cpp
+++ b/flang/lib/Optimizer/Support/InternalNames.cpp
@@ -337,6 +337,8 @@ mangleTypeDescriptorKinds(llvm::ArrayRef<std::int64_t> kinds) {
 
 static std::string getDerivedTypeObjectName(llvm::StringRef mangledTypeName,
                                             const llvm::StringRef separator) {
+  if (mangledTypeName.ends_with(boxprocSuffix))
+    mangledTypeName = mangledTypeName.drop_back(boxprocSuffix.size());
   auto result = fir::NameUniquer::deconstruct(mangledTypeName);
   if (result.first != fir::NameUniquer::NameKind::DERIVED_TYPE)
     return "";

diff  --git a/flang/test/Fir/boxproc-2.fir b/flang/test/Fir/boxproc-2.fir
index cf3931a9c231b..b9a11591e796f 100644
--- a/flang/test/Fir/boxproc-2.fir
+++ b/flang/test/Fir/boxproc-2.fir
@@ -12,3 +12,35 @@ func.func private @test3(!fir.boxproc<() -> (!fir.type<a{x:i32, y:f64}>)>) -> no
 
 //CHECK-LABEL:  func.func private @test5(((i32) -> f32) -> ())
 func.func private @test5(!fir.boxproc<(!fir.boxproc<(i32) -> (f32)>) -> ()>)
+
+// CHECK-LABEL:   func.func @proc_pointer_component(
+// CHECK-SAME:                                      %[[VAL_0:.*]]: (!fir.ref<i32>) -> f32,
+// CHECK-SAME:                                      %[[VAL_1:.*]]: !fir.ref<i32>) {
+
+func.func @proc_pointer_component(%arg0 : !fir.boxproc<(!fir.ref<i32>) -> f32>, %arg1: !fir.ref<i32>) {
+  %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
+  %1 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
+  %2 = fir.coordinate_of %0, %1 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
+  %3 = fir.convert %arg0 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) ->  !fir.boxproc<() -> ()>
+  fir.store %3 to %2 : !fir.ref<!fir.boxproc<() -> ()>>
+  %4 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
+  %5 = fir.coordinate_of %0, %4 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
+  %6 = fir.load %5 : !fir.ref<!fir.boxproc<() -> ()>>
+  %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ((!fir.ref<i32>) -> f32)
+  %9 = fir.call %8(%arg1) : (!fir.ref<i32>) -> f32
+  return
+
+// CHECK:           %[[VAL_2:.*]] = fir.alloca !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>
+// CHECK:           %[[VAL_3:.*]] = fir.field_index solve, !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>
+// CHECK:           %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>>, !fir.field) -> !fir.ref<() -> ()>
+// CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : ((!fir.ref<i32>) -> f32) -> (() -> ())
+// CHECK:           fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref<() -> ()>
+// CHECK:           %[[VAL_6:.*]] = fir.field_index solve, !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>
+// CHECK:           %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref<!fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>>, !fir.field) -> !fir.ref<() -> ()>
+// CHECK:           %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<() -> ()>
+// CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (() -> ()) -> ((!fir.ref<i32>) -> f32)
+// CHECK:           %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : ((!fir.ref<i32>) -> f32) -> ((!fir.ref<i32>) -> f32)
+// CHECK:           %[[VAL_11:.*]] = fir.call %[[VAL_10]](%[[VAL_1]]) : (!fir.ref<i32>) -> f32
+
+}


        


More information about the flang-commits mailing list