[flang-commits] [flang] [flang] add support for procedure pointer assignment inside FORALL (PR #130114)

via flang-commits flang-commits at lists.llvm.org
Thu Mar 6 06:48:24 PST 2025


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

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

Author: None (jeanPerier)

<details>
<summary>Changes</summary>

Very similar to object pointer assignment, the difference is the SSA types of the LHS (!fir.ref<!fir.boxproc<()->()>> and RHS (!fir.boxproc<()->()).

The RHS must be saved as simple address, not descriptors (it is not possible to make CFI descriptor out of procedure entity).

---

Patch is 37.86 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/130114.diff


12 Files Affected:

- (modified) flang/include/flang/Optimizer/Builder/HLFIRTools.h (+1-1) 
- (modified) flang/include/flang/Optimizer/Builder/TemporaryStorage.h (+10-9) 
- (modified) flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h (+11) 
- (modified) flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td (+3-4) 
- (modified) flang/include/flang/Optimizer/HLFIR/HLFIROps.td (+2) 
- (modified) flang/lib/Lower/Bridge.cpp (+18-9) 
- (modified) flang/lib/Optimizer/Builder/TemporaryStorage.cpp (+22-14) 
- (modified) flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp (+23-8) 
- (modified) flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIROrderedAssignments.cpp (+6-4) 
- (added) flang/test/HLFIR/order_assignments/forall-proc-pointer-assignment-codegen.f90 (+222) 
- (added) flang/test/HLFIR/order_assignments/forall-proc-pointer-assignment-scheduling-character.f90 (+126) 
- (added) flang/test/HLFIR/order_assignments/forall-proc-pointer-assignment-scheduling.f90 (+123) 


``````````diff
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index 19fc2c22f0d49..ac80873dc374f 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -60,7 +60,7 @@ class Entity : public mlir::Value {
   bool isVariable() const { return !isValue(); }
   bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); }
   bool isProcedurePointer() const {
-    return fir::isBoxProcAddressType(getType());
+    return hlfir::isFortranProcedurePointerType(getType());
   }
   bool isBoxAddressOrValue() const {
     return hlfir::isBoxAddressOrValueType(getType());
diff --git a/flang/include/flang/Optimizer/Builder/TemporaryStorage.h b/flang/include/flang/Optimizer/Builder/TemporaryStorage.h
index b17a75354e7d1..cdb23a64c5c8a 100644
--- a/flang/include/flang/Optimizer/Builder/TemporaryStorage.h
+++ b/flang/include/flang/Optimizer/Builder/TemporaryStorage.h
@@ -180,7 +180,7 @@ class AnyValueStack {
 /// dynamic type, bounds, and type parameters as the Nth variable that was
 /// pushed. It is implemented using runtime.
 /// Note that this is not meant to save POINTER or ALLOCATABLE descriptor
-/// addresses, use AnyDescriptorAddressStack instead.
+/// addresses, use AnyAddressStack instead.
 class AnyVariableStack {
 public:
   AnyVariableStack(mlir::Location loc, fir::FirOpBuilder &builder,
@@ -205,19 +205,21 @@ class AnyVariableStack {
   mlir::Value retValueBox;
 };
 
-/// Data structure to stack descriptor addresses. It stores the descriptor
-/// addresses as int_ptr values under the hood.
-class AnyDescriptorAddressStack : public AnyValueStack {
+/// Data structure to stack simple addresses (C pointers). It can be used to
+/// store data base addresses, descriptor addresses, procedure addresses, and
+/// pointer procedure address. It stores the addresses as int_ptr values under
+/// the hood.
+class AnyAddressStack : public AnyValueStack {
 public:
-  AnyDescriptorAddressStack(mlir::Location loc, fir::FirOpBuilder &builder,
-                            mlir::Type descriptorAddressType);
+  AnyAddressStack(mlir::Location loc, fir::FirOpBuilder &builder,
+                  mlir::Type addressType);
 
   void pushValue(mlir::Location loc, fir::FirOpBuilder &builder,
                  mlir::Value value);
   mlir::Value fetch(mlir::Location loc, fir::FirOpBuilder &builder);
 
 private:
-  mlir::Type descriptorAddressType;
+  mlir::Type addressType;
 };
 
 class TemporaryStorage;
@@ -281,8 +283,7 @@ class TemporaryStorage {
 
 private:
   std::variant<HomogeneousScalarStack, SimpleCopy, SSARegister, AnyValueStack,
-               AnyVariableStack, AnyVectorSubscriptStack,
-               AnyDescriptorAddressStack>
+               AnyVariableStack, AnyVectorSubscriptStack, AnyAddressStack>
       impl;
 };
 } // namespace fir::factory
diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
index 15296aa7e8c75..5152dee14ad65 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
@@ -82,6 +82,17 @@ inline bool isPolymorphicType(mlir::Type type) {
   return fir::isPolymorphicType(type);
 }
 
+/// Is this the FIR type of a Fortran procedure pointer?
+inline bool isFortranProcedurePointerType(mlir::Type type) {
+  return fir::isBoxProcAddressType(type);
+}
+
+inline bool isFortranPointerObjectType(mlir::Type type) {
+  auto boxTy =
+      llvm::dyn_cast_or_null<fir::BaseBoxType>(fir::dyn_cast_ptrEleTy(type));
+  return boxTy && boxTy.isPointer();
+}
+
 /// Is this an SSA value type for the value of a Fortran procedure
 /// designator ?
 inline bool isFortranProcedureValue(mlir::Type type) {
diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td b/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
index 1b1ac61d4550f..ee0b5aa9760b1 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
@@ -91,10 +91,9 @@ def IsFortranVariablePred
 def AnyFortranVariable : Type<IsFortranVariablePred, "any HLFIR variable type">;
 
 
-def AnyFortranValue : TypeConstraint<Or<[AnyLogicalLike.predicate,
-    AnyIntegerLike.predicate, AnyRealLike.predicate,
-    AnyFirComplexLike.predicate,
-    hlfir_ExprType.predicate]>, "any Fortran value type">;
+def IsFortranValuePred : CPred<"::hlfir::isFortranValueType($_self)">;
+def AnyFortranValue
+        : TypeConstraint<IsFortranValuePred, "any Fortran value type">;
 
 
 def AnyFortranEntity : TypeConstraint<Or<[AnyFortranVariable.predicate,
diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
index c12066b1346f6..f69930d5b53b3 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
@@ -1378,6 +1378,8 @@ def hlfir_RegionAssignOp : hlfir_Op<"region_assign", [hlfir_OrderedAssignmentTre
     }
     mlir::Region* getSubTreeRegion() { return nullptr; }
     bool isPointerAssignment();
+    bool isPointerObjectAssignment();
+    bool isProcedurePointerAssignment();
   }];
 
   let hasCustomAssemblyFormat = 1;
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 95f431983d442..2b2f0d9bcccd5 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -4353,8 +4353,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   void genForallPointerAssignment(
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
-    if (Fortran::evaluate::IsProcedureDesignator(assign.rhs))
-      TODO(loc, "procedure pointer assignment inside FORALL");
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
     // Polymorphic pointer assignment is delegated to the runtime, and
@@ -4383,7 +4381,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     Fortran::lower::StatementContext lhsContext;
     hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
         loc, *this, assign.lhs, localSymbols, lhsContext);
-
     auto lhsYieldOp = builder->create<hlfir::YieldOp>(loc, lhs);
     Fortran::lower::genCleanUpInRegionIfAny(
         loc, *builder, lhsYieldOp.getCleanup(), lhsContext);
@@ -4391,6 +4388,23 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     // Lower RHS in its own region.
     builder->createBlock(&regionAssignOp.getRhsRegion());
     Fortran::lower::StatementContext rhsContext;
+    mlir::Value rhs =
+        genForallPointerAssignmentRhs(loc, lhs, assign, rhsContext);
+    auto rhsYieldOp = builder->create<hlfir::YieldOp>(loc, rhs);
+    Fortran::lower::genCleanUpInRegionIfAny(
+        loc, *builder, rhsYieldOp.getCleanup(), rhsContext);
+
+    builder->setInsertionPointAfter(regionAssignOp);
+  }
+
+  mlir::Value
+  genForallPointerAssignmentRhs(mlir::Location loc, mlir::Value lhs,
+                                const Fortran::evaluate::Assignment &assign,
+                                Fortran::lower::StatementContext &rhsContext) {
+    if (Fortran::evaluate::IsProcedureDesignator(assign.rhs))
+      return fir::getBase(Fortran::lower::convertExprToAddress(
+          loc, *this, assign.rhs, localSymbols, rhsContext));
+    // Data target.
     hlfir::Entity rhs = Fortran::lower::convertExprToHLFIR(
         loc, *this, assign.rhs, localSymbols, rhsContext);
     // Create pointer descriptor value from the RHS.
@@ -4398,12 +4412,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       rhs = hlfir::Entity{builder->create<fir::LoadOp>(loc, rhs)};
     auto lhsBoxType =
         llvm::cast<fir::BaseBoxType>(fir::unwrapRefType(lhs.getType()));
-    mlir::Value newBox = hlfir::genVariableBox(loc, *builder, rhs, lhsBoxType);
-    auto rhsYieldOp = builder->create<hlfir::YieldOp>(loc, newBox);
-    Fortran::lower::genCleanUpInRegionIfAny(
-        loc, *builder, rhsYieldOp.getCleanup(), rhsContext);
-
-    builder->setInsertionPointAfter(regionAssignOp);
+    return hlfir::genVariableBox(loc, *builder, rhs, lhsBoxType);
   }
 
   // Create the 2 x newRank array with the bounds to be passed to the runtime as
diff --git a/flang/lib/Optimizer/Builder/TemporaryStorage.cpp b/flang/lib/Optimizer/Builder/TemporaryStorage.cpp
index 48c2cb2181a0b..9d2e9837a3df8 100644
--- a/flang/lib/Optimizer/Builder/TemporaryStorage.cpp
+++ b/flang/lib/Optimizer/Builder/TemporaryStorage.cpp
@@ -357,25 +357,33 @@ void fir::factory::AnyVectorSubscriptStack::destroy(
 }
 
 //===----------------------------------------------------------------------===//
-// fir::factory::AnyDescriptorAddressStack implementation.
+// fir::factory::AnyAddressStack implementation.
 //===----------------------------------------------------------------------===//
 
-fir::factory::AnyDescriptorAddressStack::AnyDescriptorAddressStack(
-    mlir::Location loc, fir::FirOpBuilder &builder,
-    mlir::Type descriptorAddressType)
+fir::factory::AnyAddressStack::AnyAddressStack(mlir::Location loc,
+                                               fir::FirOpBuilder &builder,
+                                               mlir::Type addressType)
     : AnyValueStack(loc, builder, builder.getIntPtrType()),
-      descriptorAddressType{descriptorAddressType} {}
-
-void fir::factory::AnyDescriptorAddressStack::pushValue(
-    mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value variable) {
-  mlir::Value cast =
-      builder.createConvert(loc, builder.getIntPtrType(), variable);
+      addressType{addressType} {}
+
+void fir::factory::AnyAddressStack::pushValue(mlir::Location loc,
+                                              fir::FirOpBuilder &builder,
+                                              mlir::Value variable) {
+  mlir::Value cast = variable;
+  if (auto boxProcType = llvm::dyn_cast<fir::BoxProcType>(variable.getType())) {
+    cast =
+        builder.create<fir::BoxAddrOp>(loc, boxProcType.getEleTy(), variable);
+  }
+  cast = builder.createConvert(loc, builder.getIntPtrType(), cast);
   static_cast<AnyValueStack *>(this)->pushValue(loc, builder, cast);
 }
 
-mlir::Value
-fir::factory::AnyDescriptorAddressStack::fetch(mlir::Location loc,
-                                               fir::FirOpBuilder &builder) {
+mlir::Value fir::factory::AnyAddressStack::fetch(mlir::Location loc,
+                                                 fir::FirOpBuilder &builder) {
   mlir::Value addr = static_cast<AnyValueStack *>(this)->fetch(loc, builder);
-  return builder.createConvert(loc, descriptorAddressType, addr);
+  if (auto boxProcType = llvm::dyn_cast<fir::BoxProcType>(addressType)) {
+    mlir::Value cast = builder.createConvert(loc, boxProcType.getEleTy(), addr);
+    return builder.create<fir::EmboxProcOp>(loc, boxProcType, cast);
+  }
+  return builder.createConvert(loc, addressType, addr);
 }
diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
index 383e6a2630537..8851a3a7187b9 100644
--- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
@@ -1891,18 +1891,33 @@ llvm::LogicalResult hlfir::RegionAssignOp::verify() {
   return mlir::success();
 }
 
-bool hlfir::RegionAssignOp::isPointerAssignment() {
+static mlir::Type
+getNonVectorSubscriptedLhsType(hlfir::RegionAssignOp regionAssign) {
+  hlfir::YieldOp yieldOp = mlir::dyn_cast_or_null<hlfir::YieldOp>(
+      getTerminator(regionAssign.getLhsRegion()));
+  return yieldOp ? yieldOp.getEntity().getType() : mlir::Type{};
+}
+
+bool hlfir::RegionAssignOp::isPointerObjectAssignment() {
   if (!getUserDefinedAssignment().empty())
     return false;
-  hlfir::YieldOp yieldOp =
-      mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(getLhsRegion()));
-  if (!yieldOp)
+  mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);
+  return lhsType && hlfir::isFortranPointerObjectType(lhsType);
+}
+
+bool hlfir::RegionAssignOp::isProcedurePointerAssignment() {
+  if (!getUserDefinedAssignment().empty())
     return false;
-  mlir::Type lhsType = yieldOp.getEntity().getType();
-  if (!hlfir::isBoxAddressType(lhsType))
+  mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);
+  return lhsType && hlfir::isFortranProcedurePointerType(lhsType);
+}
+
+bool hlfir::RegionAssignOp::isPointerAssignment() {
+  if (!getUserDefinedAssignment().empty())
     return false;
-  auto baseBoxType = llvm::cast<fir::BaseBoxType>(fir::unwrapRefType(lhsType));
-  return baseBoxType.isPointer();
+  mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);
+  return lhsType && (hlfir::isFortranPointerObjectType(lhsType) ||
+                     hlfir::isFortranProcedurePointerType(lhsType));
 }
 
 //===----------------------------------------------------------------------===//
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIROrderedAssignments.cpp b/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIROrderedAssignments.cpp
index 7561daefa3b83..5cae7cf443c86 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIROrderedAssignments.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/LowerHLFIROrderedAssignments.cpp
@@ -1277,11 +1277,13 @@ void OrderedAssignmentRewriter::saveNonVectorSubscriptedAddress(
         [&] { temp = insertSavedEntity(region, fir::factory::SSARegister{}); });
   else
     doBeforeLoopNest([&] {
-      if (var.isMutableBox())
-        temp =
-            insertSavedEntity(region, fir::factory::AnyDescriptorAddressStack{
-                                          loc, builder, var.getType()});
+      if (var.isMutableBox() || var.isProcedure() || var.isProcedurePointer())
+        // Store single C pointer to entity.
+        temp = insertSavedEntity(
+            region, fir::factory::AnyAddressStack{loc, builder, var.getType()});
       else
+        // Store the base address and dynamic shape/length/type information
+        // as descriptor.
         temp = insertSavedEntity(region, fir::factory::AnyVariableStack{
                                              loc, builder, var.getType()});
     });
diff --git a/flang/test/HLFIR/order_assignments/forall-proc-pointer-assignment-codegen.f90 b/flang/test/HLFIR/order_assignments/forall-proc-pointer-assignment-codegen.f90
new file mode 100644
index 0000000000000..c5fcc4d943927
--- /dev/null
+++ b/flang/test/HLFIR/order_assignments/forall-proc-pointer-assignment-codegen.f90
@@ -0,0 +1,222 @@
+// Test code generation of hlfir.region_assign representing procedure pointer
+// assignments inside FORALL.
+
+// RUN: fir-opt %s --lower-hlfir-ordered-assignments | FileCheck %s
+
+!t=!fir.type<t{p:!fir.boxproc<() -> i32>}>
+func.func @test_no_conflict(%arg0: !fir.ref<!fir.array<10x!t>> {fir.bindc_name = "x"}) {
+  %c10_i64 = arith.constant 10 : i64
+  %c1_i64 = arith.constant 1 : i64
+  %c10 = arith.constant 10 : index
+  %0 = fir.dummy_scope : !fir.dscope
+  %1 = fir.shape %c10 : (index) -> !fir.shape<1>
+  %2:2 = hlfir.declare %arg0(%1) dummy_scope %0 {uniq_name = "x"} : (!fir.ref<!fir.array<10x!t>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<10x!t>>, !fir.ref<!fir.array<10x!t>>)
+  hlfir.forall lb {
+    hlfir.yield %c1_i64 : i64
+  } ub {
+    hlfir.yield %c10_i64 : i64
+  }  (%arg1: i64) {
+    hlfir.region_assign {
+      %3 = fir.address_of(@f1) : () -> i32
+      %4 = fir.emboxproc %3 : (() -> i32) -> !fir.boxproc<() -> ()>
+      hlfir.yield %4 : !fir.boxproc<() -> ()>
+    } to {
+      %3 = hlfir.designate %2#0 (%arg1)  : (!fir.ref<!fir.array<10x!t>>, i64) -> !fir.ref<!t>
+      %4 = hlfir.designate %3{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!t>) -> !fir.ref<!fir.boxproc<() -> i32>>
+      hlfir.yield %4 : !fir.ref<!fir.boxproc<() -> i32>>
+    }
+  }
+  return
+}
+// CHECK-LABEL:   func.func @test_no_conflict(
+// CHECK:           %[[VAL_1:.*]] = arith.constant 10 : i64
+// CHECK:           %[[VAL_2:.*]] = arith.constant 1 : i64
+// CHECK:           %[[VAL_3:.*]] = arith.constant 10 : index
+// CHECK:           %[[VAL_4:.*]] = fir.dummy_scope : !fir.dscope
+// CHECK:           %[[VAL_5:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare{{.*}}"x"
+// CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (i64) -> index
+// CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (i64) -> index
+// CHECK:           %[[VAL_9:.*]] = arith.constant 1 : index
+// CHECK:           fir.do_loop %[[VAL_10:.*]] = %[[VAL_7]] to %[[VAL_8]] step %[[VAL_9]] {
+// CHECK:             %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (index) -> i64
+// CHECK:             %[[VAL_12:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_11]])  : (!fir.ref<!fir.array<10x!fir.type<t{p:!fir.boxproc<() -> i32>}>>>, i64) -> !fir.ref<!fir.type<t{p:!fir.boxproc<() -> i32>}>>
+// CHECK:             %[[VAL_13:.*]] = hlfir.designate %[[VAL_12]]{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<t{p:!fir.boxproc<() -> i32>}>>) -> !fir.ref<!fir.boxproc<() -> i32>>
+// CHECK:             %[[VAL_14:.*]] = fir.address_of(@f1) : () -> i32
+// CHECK:             %[[VAL_15:.*]] = fir.emboxproc %[[VAL_14]] : (() -> i32) -> !fir.boxproc<() -> ()>
+// CHECK:             %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<() -> i32>
+// CHECK:             fir.store %[[VAL_16]] to %[[VAL_13]] : !fir.ref<!fir.boxproc<() -> i32>>
+// CHECK:           }
+// CHECK:           return
+// CHECK:         }
+
+func.func @test_need_to_save_rhs(%arg0: !fir.ref<!fir.array<10x!t>> {fir.bindc_name = "x"}) {
+  %c10_i64 = arith.constant 10 : i64
+  %c1_i64 = arith.constant 1 : i64
+  %c10 = arith.constant 10 : index
+  %0 = fir.dummy_scope : !fir.dscope
+  %1 = fir.shape %c10 : (index) -> !fir.shape<1>
+  %2:2 = hlfir.declare %arg0(%1) dummy_scope %0 {uniq_name = "x"} : (!fir.ref<!fir.array<10x!t>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<10x!t>>, !fir.ref<!fir.array<10x!t>>)
+  hlfir.forall lb {
+    hlfir.yield %c1_i64 : i64
+  } ub {
+    hlfir.yield %c10_i64 : i64
+  }  (%arg1: i64) {
+    hlfir.region_assign {
+      %3 = hlfir.designate %2#0 (%c10)  : (!fir.ref<!fir.array<10x!t>>, index) -> !fir.ref<!t>
+      %4 = hlfir.designate %3{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!t>) -> !fir.ref<!fir.boxproc<() -> i32>>
+      %5 = fir.load %4 : !fir.ref<!fir.boxproc<() -> i32>>
+      hlfir.yield %5 : !fir.boxproc<() -> i32>
+    } to {
+      %3 = hlfir.designate %2#0 (%arg1)  : (!fir.ref<!fir.array<10x!t>>, i64) -> !fir.ref<!t>
+      %4 = hlfir.designate %3{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!t>) -> !fir.ref<!fir.boxproc<() -> i32>>
+      hlfir.yield %4 : !fir.ref<!fir.boxproc<() -> i32>>
+    }
+  }
+  return
+}
+// CHECK-LABEL:   func.func @test_need_to_save_rhs(
+// CHECK:           %[[VAL_1:.*]] = fir.alloca i64
+// CHECK:           %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.heap<i64>>
+// CHECK:           %[[VAL_3:.*]] = fir.alloca i64
+// CHECK:           %[[VAL_4:.*]] = arith.constant 10 : i64
+// CHECK:           %[[VAL_5:.*]] = arith.constant 1 : i64
+// CHECK:           %[[VAL_6:.*]] = arith.constant 10 : index
+// CHECK:           %[[VAL_7:.*]] = fir.dummy_scope : !fir.dscope
+// CHECK:           %[[VAL_8:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_9:.*]]:2 = hlfir.declare{{.*}}x
+// CHECK:           %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
+// CHECK:           %[[VAL_11:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
+// CHECK:           %[[VAL_12:.*]] = arith.constant 1 : index
+// CHECK:           %[[VAL_13:.*]] = arith.constant 0 : i64
+// CHECK:           %[[VAL_14:.*]] = arith.constant 1 : i64
+// CHECK:           fir.store %[[VAL_13]] to %[[VAL_3]] : !fir.ref<i64>
+// CHECK:           %[[VAL_19:.*]] = fir.call @_FortranACreateValueStack(
+// CHECK:           fir.do_loop %[[VAL_20:.*]] = %[[VAL_10]] to %[[VAL_11]] step %[[VAL_12]] {
+// CHECK:             %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (index) -> i64
+// CHECK:             %[[VAL_22:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_6]])  : (!fir.ref<!fir.array<10x!fir.type<t{p:!fir.boxproc<() -> i32>}>>>, index) -> !fir.ref<!fir.type<t{p:!fir.boxproc<() -> i32>}>>
+// CHECK:             %[[VAL_23:.*]] = hlfir.designate %[[V...
[truncated]

``````````

</details>


https://github.com/llvm/llvm-project/pull/130114


More information about the flang-commits mailing list