[flang][hlfir] Fixed array constructor lowering.

[vzakhari]

Summary

First issue is that the clean-ups were generated after the yield_element
operation that must be the terminator. Second issue is that codegen for
elemenal operation was not working properly with nested elemental ops.

[jeanPerier]

Thanks a lot for figuring out the issue here and fixing this!

flang/lib/Optimizer/Builder/HLFIRTools.cpp

749

I agree.
This would not simplify the bufferize pass situation with YieldOp, right ? As I understand it occurs when a YieldElementOp is clone as part of an hlfir::ElementalOp cloning.

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

594

It could also simply be unconditionally legal (target.addLegalOp<hlfir::YieldElementOp>, and removed from the target.addIllegalOp list) since it has no pattern anyway as you point out, and that the verifier would still complain if one remains after the pass since it has the HasParent<ElementalOp> trait and hlfir::ElementalOp is illegal here.

[vzakhari]

flang/lib/Optimizer/Builder/HLFIRTools.cpp

749

Yes, it would not change much for the bufferize pass, except that it will not have to erase the cloned YieldElementOp.

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

594

Thank you! This makes sense.

flang/lib/Lower/ConvertArrayConstructor.cpp

 //   The array constructor lowering looks like:
 //   ```
 //     strategy = selectArrayCtorLoweringStrategy(array-ctor-expr);
 //     for (ac-value : array-ctor-expr)
 //       if (ac-value is expression) {
 //         strategy.pushValue(ac-value);
 //       } else if (ac-value is implied-do) {
 //         strategy.startImpliedDo(lower, upper, stride);
+//         strategy.startImpliedDoScope();
 //         // lower nested values
+//         ...
+//         strategy.endImpliedDoScope();
 //       }
 //     result = strategy.finishArrayCtorLowering();
 //   ```
 
 //===----------------------------------------------------------------------===//
 //   Definition of the lowering strategies. Each lowering strategy is defined
-//   as a class that implements "pushValue", "startImpliedDo", and
-//   "finishArrayCtorLowering".
+//   as a class that implements "pushValue", "startImpliedDo" and
+//   "finishArrayCtorLowering". A strategy may optionally override
+//   "startImpliedDoScope" and "endImpliedDoScope" virtual methods
+//   of its base class StrategyBase.
 //===----------------------------------------------------------------------===//
 
 namespace {
+/// Class provides common implementation of scope push/pop methods
+/// that update StatementContext scopes and SymMap bindings.
+/// They might be overridden by the lowering strategies, e.g.
+/// see AsElementalStrategy.
+class StrategyBase {
+public:
+  StrategyBase(Fortran::lower::StatementContext &stmtCtx,
+               Fortran::lower::SymMap &symMap)
+      : stmtCtx{stmtCtx}, symMap{symMap} {};
+  virtual ~StrategyBase() = default;
+
+  virtual void startImpliedDoScope(llvm::StringRef doName,
+                                   mlir::Value indexValue) {
+    symMap.pushImpliedDoBinding(doName, indexValue);
+    stmtCtx.pushScope();
+  }
+
+  virtual void endImpliedDoScope() {
+    stmtCtx.finalizeAndPop();
+    symMap.popImpliedDoBinding();
+  }
+
+protected:
+  Fortran::lower::StatementContext &stmtCtx;
+  Fortran::lower::SymMap &symMap;
+};
+
 /// Class that implements the "inlined temp strategy" to lower array
 /// constructors. It must be further provided a CounterType class to specify how
 /// the current ac-value insertion position is tracked.
 template <typename CounterType>
-class InlinedTempStrategyImpl {
+class InlinedTempStrategyImpl : public StrategyBase {
   /// Name that will be given to the temporary allocation and hlfir.declare in
   /// the IR.
   static constexpr char tempName[] = ".tmp.arrayctor";
 
 public:
   /// Start lowering an array constructor according to the inline strategy.
   /// The temporary is created right away.
   InlinedTempStrategyImpl(mlir::Location loc, fir::FirOpBuilder &builder,
+                          Fortran::lower::StatementContext &stmtCtx,
+                          Fortran::lower::SymMap &symMap,
                           fir::SequenceType declaredType, mlir::Value extent,
                           llvm::ArrayRef<mlir::Value> lengths)
-      : one{builder.createIntegerConstant(loc, builder.getIndexType(), 1)},
+      : StrategyBase{stmtCtx, symMap},
+        one{builder.createIntegerConstant(loc, builder.getIndexType(), 1)},
         counter{loc, builder, one} {
     // Allocate the temporary storage.
     llvm::SmallVector<mlir::Value, 1> extents{extent};
     mlir::Value tempStorage = builder.createHeapTemporary(
         loc, declaredType, tempName, extents, lengths);
     mlir::Value shape = builder.genShape(loc, extents);
     temp =
         builder

 /// is part of a more complex elemental expression, or an assignment, it will be
 /// trivial to "inline" it in the expression or assignment loops if allowed by
 /// alias analysis.
 /// This lowering is however only possible for the form of array constructors as
 /// in the illustration above. It could be extended to deeper independent
 /// implied-do nest and wrapped in an hlfir.reshape to a rank 1 array. But this
 /// op does not exist yet, so this is left for the future if it appears
 /// profitable.
-class AsElementalStrategy {
+class AsElementalStrategy : public StrategyBase {
 public:
   /// The constructor only gathers the operands to create the hlfir.elemental.
   AsElementalStrategy(mlir::Location loc, fir::FirOpBuilder &builder,
+                      Fortran::lower::StatementContext &stmtCtx,
+                      Fortran::lower::SymMap &symMap,
                       fir::SequenceType declaredType, mlir::Value extent,
                       llvm::ArrayRef<mlir::Value> lengths)
-      : shape{builder.genShape(loc, {extent})},
-        lengthParams{lengths.begin(), lengths.end()}, exprType{getExprType(
-                                                          declaredType)} {}
+      : StrategyBase{stmtCtx, symMap}, shape{builder.genShape(loc, {extent})},
+        lengthParams{lengths.begin(), lengths.end()},
+        exprType{getExprType(declaredType)} {}
 
   static hlfir::ExprType getExprType(fir::SequenceType declaredType) {
     // Note: 7.8 point 4: the dynamic type of an array constructor is its static
     // type, it is not polymorphic.
     return hlfir::ExprType::get(declaredType.getContext(),
                                 declaredType.getShape(),
                                 declaredType.getEleTy(),
                                 /*isPolymorphic=*/false);
public:
   void pushValue(mlir::Location loc, fir::FirOpBuilder &builder,
                  hlfir::Entity value) {
     assert(value.isScalar() && "cannot use hlfir.elemental with array values");
     assert(elementalOp && "array constructor must contain an outer implied-do");
     mlir::Value elementResult = value;
     if (fir::isa_trivial(elementResult.getType()))
       elementResult =
           builder.createConvert(loc, exprType.getElementType(), elementResult);
+
+    // The clean-ups associated with the implied-do body operations
+    // must be initiated before the YieldElementOp, so we have to pop the scope
+    // right now.
+    stmtCtx.finalizeAndPop();
+
     builder.create<hlfir::YieldElementOp>(loc, elementResult);
   }
 
+  // Override the default, because the context scope must be popped in
+  // pushValue().
+  virtual void endImpliedDoScope() override { symMap.popImpliedDoBinding(); }
+
   /// Return the created hlfir.elemental.
   hlfir::Entity finishArrayCtorLowering(mlir::Location loc,
                                         fir::FirOpBuilder &builder) {
     return hlfir::Entity{elementalOp};
   }
 
 private:
   mlir::Value shape;
   llvm::SmallVector<mlir::Value> lengthParams;
   hlfir::ExprType exprType;
   hlfir::ElementalOp elementalOp{};
 };
 
 /// Class that implements the "runtime temp strategy" to lower array
 /// constructors.
-class RuntimeTempStrategy {
+class RuntimeTempStrategy : public StrategyBase {
   /// Name that will be given to the temporary allocation and hlfir.declare in
   /// the IR.
   static constexpr char tempName[] = ".tmp.arrayctor";
 
 public:
   /// Start lowering an array constructor according to the runtime strategy.
   /// The temporary is only created if the extents and length parameters are
   /// already known. Otherwise, the handling of the allocation (and
   /// reallocation) is left up to the runtime.
   /// \p extent is the pre-computed extent of the array constructor, if it could
   /// be pre-computed. It is std::nullopt otherwise.
   /// \p lengths are the pre-computed length parameters of the array
   /// constructor, if they could be precomputed. \p missingLengthParameters is
   /// set to true if the length parameters could not be precomputed.
   RuntimeTempStrategy(mlir::Location loc, fir::FirOpBuilder &builder,
+                      Fortran::lower::StatementContext &stmtCtx,
+                      Fortran::lower::SymMap &symMap,
                       fir::SequenceType declaredType,
                       std::optional<mlir::Value> extent,
                       llvm::ArrayRef<mlir::Value> lengths,
                       bool missingLengthParameters)
-      : arrayConstructorElementType{declaredType.getEleTy()} {
+      : StrategyBase{stmtCtx, symMap},
+        arrayConstructorElementType{declaredType.getEleTy()} {
     mlir::Type heapType = fir::HeapType::get(declaredType);
     mlir::Type boxType = fir::BoxType::get(heapType);
     allocatableTemp = builder.createTemporary(loc, boxType, tempName);
     mlir::Value initialBoxValue;
     if (extent && !missingLengthParameters) {
       llvm::SmallVector<mlir::Value, 1> extents{*extent};
       mlir::Value tempStorage = builder.createHeapTemporary(
           loc, declaredType, tempName, extents, lengths);
public:
 
   hlfir::Entity finishArrayCtorLowering(mlir::Location loc,
                                         fir::FirOpBuilder &builder) {
     return std::visit(
         [&](auto &impl) { return impl.finishArrayCtorLowering(loc, builder); },
         implVariant);
   }
 
+  void startImpliedDoScope(llvm::StringRef doName, mlir::Value indexValue) {
+    std::visit(
+        [&](auto &impl) {
+          return impl.startImpliedDoScope(doName, indexValue);
+        },
+        implVariant);
+  }
+
+  void endImpliedDoScope() {
+    std::visit([&](auto &impl) { return impl.endImpliedDoScope(); },
+               implVariant);
+  }
+
 private:
   std::variant<InlinedTempStrategy, LooplessInlinedTempStrategy,
                AsElementalStrategy, RuntimeTempStrategy>
       implVariant;
 };
 } // namespace
 
 //===----------------------------------------------------------------------===//
bool needToEvaluateOneExprToGetLengthParameters =
       missingLengthParameters(elementType, lengths);
   auto declaredType = fir::SequenceType::get({typeExtent}, elementType);
 
   // Based on what was gathered and the result of the analysis, select and
   // instantiate the right lowering strategy for the array constructor.
   if (!extent || needToEvaluateOneExprToGetLengthParameters ||
       analysis.anyArrayExpr || declaredType.getEleTy().isa<fir::RecordType>())
     return RuntimeTempStrategy(
-        loc, builder, declaredType,
+        loc, builder, stmtCtx, symMap, declaredType,
         extent ? std::optional<mlir::Value>(extent) : std::nullopt, lengths,
         needToEvaluateOneExprToGetLengthParameters);
   // Note: array constructors containing impure ac-value expr are currently not
   // rewritten to hlfir.elemental because impure expressions should be evaluated
   // in order, and hlfir.elemental currently misses a way to indicate that.
   if (analysis.isSingleImpliedDoWithOneScalarPureExpr())
-    return AsElementalStrategy(loc, builder, declaredType, extent, lengths);
+    return AsElementalStrategy(loc, builder, stmtCtx, symMap, declaredType,
+                               extent, lengths);
 
   if (analysis.anyImpliedDo)
-    return InlinedTempStrategy(loc, builder, declaredType, extent, lengths);
+    return InlinedTempStrategy(loc, builder, stmtCtx, symMap, declaredType,
+                               extent, lengths);
 
-  return LooplessInlinedTempStrategy(loc, builder, declaredType, extent,
-                                     lengths);
+  return LooplessInlinedTempStrategy(loc, builder, stmtCtx, symMap,
+                                     declaredType, extent, lengths);
 }
 
 /// Lower an ac-value expression \p expr and forward it to the selected
 /// lowering strategy \p arrayBuilder,
 template <typename T>
 static void genAcValue(mlir::Location loc,
                        Fortran::lower::AbstractConverter &converter,
                        const Fortran::evaluate::Expr<T> &expr,
static void genAcValue(mlir::Location loc,
   };
   mlir::Value lower = lowerIndex(impledDo.lower());
   mlir::Value upper = lowerIndex(impledDo.upper());
   mlir::Value stride = lowerIndex(impledDo.stride());
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();
   mlir::Value impliedDoIndexValue =
       arrayBuilder.startImpliedDo(loc, builder, lower, upper, stride);
-  symMap.pushImpliedDoBinding(toStringRef(impledDo.name()),
+  arrayBuilder.startImpliedDoScope(toStringRef(impledDo.name()),
                                    impliedDoIndexValue);
-  stmtCtx.pushScope();
 
   for (const auto &acValue : impledDo.values())
     std::visit(
         [&](const auto &x) {
           genAcValue(loc, converter, x, symMap, stmtCtx, arrayBuilder);
         },
         acValue.u);
 
-  stmtCtx.finalizeAndPop();
-  symMap.popImpliedDoBinding();
+  arrayBuilder.endImpliedDoScope();
   builder.restoreInsertionPoint(insertPt);
 }
 
 /// Entry point for evaluate::ArrayConstructor lowering.
 template <typename T>
 hlfir::EntityWithAttributes Fortran::lower::ArrayConstructorBuilder<T>::gen(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::evaluate::ArrayConstructor<T> &arrayCtorExpr,

flang/lib/Optimizer/Builder/HLFIRTools.cpp

hlfir::genElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
   // here.
   if (fir::isa_trivial(elementResult.getType()))
     elementResult = builder.createConvert(loc, elementType, elementResult);
   builder.create<hlfir::YieldElementOp>(loc, elementResult);
   builder.restoreInsertionPoint(insertPt);
   return elementalOp;
 }
 
+// TODO: we do not actually need to clone the YieldElementOp,
+// because returning its getElementValue() operand should be enough
+// for all callers of this function.
 hlfir::YieldElementOp
 hlfir::inlineElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
                          hlfir::ElementalOp elemental,
                          mlir::ValueRange oneBasedIndices) {
   // hlfir.elemental region is a SizedRegion<1>.
   assert(elemental.getRegion().hasOneBlock() &&
          "expect elemental region to have one block");
   mlir::IRMapping mapper;

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

struct HLFIRListener : public mlir::OpBuilder::Listener {
   fir::FirOpBuilder &builder;
   mlir::ConversionPatternRewriter &rewriter;
 };
 
 struct ElementalOpConversion
     : public mlir::OpConversionPattern<hlfir::ElementalOp> {
   using mlir::OpConversionPattern<hlfir::ElementalOp>::OpConversionPattern;
   explicit ElementalOpConversion(mlir::MLIRContext *ctx)
-      : mlir::OpConversionPattern<hlfir::ElementalOp>{ctx} {}
+      : mlir::OpConversionPattern<hlfir::ElementalOp>{ctx} {
+    // This pattern recursively converts nested ElementalOp's
+    // by cloning and then converting them, so we have to allow
+    // for recursive pattern application. The recursion is bounded
+    // by the nesting level of ElementalOp's.
+    setHasBoundedRewriteRecursion();
+  }
   mlir::LogicalResult
   matchAndRewrite(hlfir::ElementalOp elemental, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override {
     mlir::Location loc = elemental->getLoc();
     auto module = elemental->getParentOfType<mlir::ModuleOp>();
     fir::FirOpBuilder builder(rewriter, fir::getKindMapping(module));
     // The body of the elemental op may contain operation that will require
     // to be translated. Notify the rewriter about the cloned operations.
void runOnOperation() override {
     auto *context = &getContext();
     mlir::RewritePatternSet patterns(context);
     patterns.insert<ApplyOpConversion, AsExprOpConversion, AssignOpConversion,
                     AssociateOpConversion, ConcatOpConversion,
                     DestroyOpConversion, ElementalOpConversion,
                     EndAssociateOpConversion, NoReassocOpConversion,
                     SetLengthOpConversion, ShapeOfOpConversion>(context);
     mlir::ConversionTarget target(*context);
+    // Note that YieldElementOp is not marked as an illegal operation.
+    // It must be erased by its parent converter and there is no explicit
+    // conversion pattern to YieldElementOp itself. If any YieldElementOp
+    // survives this pass, the verifier will detect it because it has to be
+    // a child of ElementalOp and ElementalOp's are explicitly illegal.
     target.addIllegalOp<hlfir::ApplyOp, hlfir::AssociateOp, hlfir::ElementalOp,
-                        hlfir::EndAssociateOp, hlfir::SetLengthOp,
-                        hlfir::YieldElementOp>();
+                        hlfir::EndAssociateOp, hlfir::SetLengthOp>();
+
     target.markUnknownOpDynamicallyLegal([](mlir::Operation *op) {
       return llvm::all_of(
                  op->getResultTypes(),
                  [](mlir::Type ty) { return !ty.isa<hlfir::ExprType>(); }) &&
              llvm::all_of(op->getOperandTypes(), [](mlir::Type ty) {
                return !ty.isa<hlfir::ExprType>();
              });
     });
     if (mlir::failed(
             mlir::applyFullConversion(module, target, std::move(patterns)))) {
       mlir::emitError(mlir::UnknownLoc::get(context),
                       "failure in HLFIR bufferization pass");
       signalPassFailure();
     }
   }
 };
 } // namespace
 
 std::unique_ptr<mlir::Pass> hlfir::createBufferizeHLFIRPass() {
   return std::make_unique<BufferizeHLFIR>();
 }

flang/test/HLFIR/elemental-codegen-nested.fir

+// Test nested hlfir.elemental code generation
+// RUN: fir-opt %s --bufferize-hlfir | FileCheck %s
+
+// CHECK-LABEL:   func.func @_QPtest(
+// CHECK-SAME:                       %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "pi"},
+// CHECK-SAME:                       %[[VAL_1:.*]]: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "h1"}) {
+// CHECK:           %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:           %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_3]]) {uniq_name = "_QFtestEh1"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>)
+// CHECK:           %[[VAL_5:.*]] = fir.alloca i32 {bindc_name = "k", uniq_name = "_QFtestEk"}
+// CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {uniq_name = "_QFtestEk"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+// CHECK:           %[[VAL_7:.*]] = fir.alloca i32 {bindc_name = "l", uniq_name = "_QFtestEl"}
+// CHECK:           %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] {uniq_name = "_QFtestEl"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+// CHECK:           %[[VAL_9:.*]] = fir.address_of(@_QFtestECn) : !fir.ref<i32>
+// CHECK:           %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtestECn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+// CHECK:           %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtestEpi"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+// CHECK:           %[[VAL_12:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_13:.*]] = fir.allocmem !fir.array<2xf32> {bindc_name = ".tmp.array", uniq_name = ""}
+// CHECK:           %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_13]](%[[VAL_12]]) {uniq_name = ".tmp.array"} : (!fir.heap<!fir.array<2xf32>>, !fir.shape<1>) -> (!fir.heap<!fir.array<2xf32>>, !fir.heap<!fir.array<2xf32>>)
+// CHECK:           %[[VAL_15:.*]] = arith.constant true
+// CHECK:           %[[VAL_16:.*]] = arith.constant 1 : index
+// CHECK:           fir.do_loop %[[VAL_17:.*]] = %[[VAL_16]] to %[[VAL_2]] step %[[VAL_16]] {
+// CHECK:             %[[VAL_18:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+// CHECK:             %[[VAL_19:.*]] = fir.allocmem !fir.array<2xf32> {bindc_name = ".tmp.array", uniq_name = ""}
+// CHECK:             %[[VAL_20:.*]]:2 = hlfir.declare %[[VAL_19]](%[[VAL_18]]) {uniq_name = ".tmp.array"} : (!fir.heap<!fir.array<2xf32>>, !fir.shape<1>) -> (!fir.heap<!fir.array<2xf32>>, !fir.heap<!fir.array<2xf32>>)
+// CHECK:             %[[VAL_21:.*]] = arith.constant true
+// CHECK:             %[[VAL_22:.*]] = arith.constant 1 : index
+// CHECK:             fir.do_loop %[[VAL_23:.*]] = %[[VAL_22]] to %[[VAL_2]] step %[[VAL_22]] {
+// CHECK:               %[[VAL_24:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref<f32>
+// CHECK:               %[[VAL_25:.*]] = hlfir.designate %[[VAL_20]]#0 (%[[VAL_23]])  : (!fir.heap<!fir.array<2xf32>>, index) -> !fir.ref<f32>
+// CHECK:               hlfir.assign %[[VAL_24]] to %[[VAL_25]] : f32, !fir.ref<f32>
+// CHECK:             }
+// CHECK:             %[[VAL_26:.*]] = fir.undefined tuple<!fir.heap<!fir.array<2xf32>>, i1>
+// CHECK:             %[[VAL_27:.*]] = fir.insert_value %[[VAL_26]], %[[VAL_21]], [1 : index] : (tuple<!fir.heap<!fir.array<2xf32>>, i1>, i1) -> tuple<!fir.heap<!fir.array<2xf32>>, i1>
+// CHECK:             %[[VAL_28:.*]] = fir.insert_value %[[VAL_27]], %[[VAL_20]]#0, [0 : index] : (tuple<!fir.heap<!fir.array<2xf32>>, i1>, !fir.heap<!fir.array<2xf32>>) -> tuple<!fir.heap<!fir.array<2xf32>>, i1>
+// CHECK:             %[[VAL_29:.*]] = fir.convert %[[VAL_20]]#0 : (!fir.heap<!fir.array<2xf32>>) -> !fir.ref<!fir.array<2xf32>>
+// CHECK:             %[[VAL_30:.*]] = fir.convert %[[VAL_20]]#1 : (!fir.heap<!fir.array<2xf32>>) -> !fir.ref<!fir.array<2xf32>>
+// CHECK:             %[[VAL_31:.*]] = fir.embox %[[VAL_29]](%[[VAL_18]]) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
+// CHECK:             %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (!fir.box<!fir.array<2xf32>>) -> !fir.box<!fir.array<?xf32>>
+// CHECK:             %[[VAL_33:.*]] = fir.call @_QPfoo(%[[VAL_32]]) fastmath<contract> : (!fir.box<!fir.array<?xf32>>) -> f32
+// CHECK:             %[[VAL_34:.*]] = fir.convert %[[VAL_30]] : (!fir.ref<!fir.array<2xf32>>) -> !fir.heap<!fir.array<2xf32>>
+// CHECK:             fir.freemem %[[VAL_34]] : !fir.heap<!fir.array<2xf32>>
+// CHECK:             %[[VAL_35:.*]] = hlfir.designate %[[VAL_14]]#0 (%[[VAL_17]])  : (!fir.heap<!fir.array<2xf32>>, index) -> !fir.ref<f32>
+// CHECK:             hlfir.assign %[[VAL_33]] to %[[VAL_35]] : f32, !fir.ref<f32>
+// CHECK:           }
+// CHECK:           %[[VAL_36:.*]] = fir.undefined tuple<!fir.heap<!fir.array<2xf32>>, i1>
+// CHECK:           %[[VAL_37:.*]] = fir.insert_value %[[VAL_36]], %[[VAL_15]], [1 : index] : (tuple<!fir.heap<!fir.array<2xf32>>, i1>, i1) -> tuple<!fir.heap<!fir.array<2xf32>>, i1>
+// CHECK:           %[[VAL_38:.*]] = fir.insert_value %[[VAL_37]], %[[VAL_14]]#0, [0 : index] : (tuple<!fir.heap<!fir.array<2xf32>>, i1>, !fir.heap<!fir.array<2xf32>>) -> tuple<!fir.heap<!fir.array<2xf32>>, i1>
+// CHECK:           hlfir.assign %[[VAL_14]]#0 to %[[VAL_4]]#0 : !fir.heap<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>
+// CHECK:           fir.freemem %[[VAL_14]]#1 : !fir.heap<!fir.array<2xf32>>
+// CHECK:           return
+// CHECK:         }
+func.func @_QPtest(%arg0: !fir.ref<f32> {fir.bindc_name = "pi"}, %arg1: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "h1"}) {
+  %c2 = arith.constant 2 : index
+  %0 = fir.shape %c2 : (index) -> !fir.shape<1>
+  %1:2 = hlfir.declare %arg1(%0) {uniq_name = "_QFtestEh1"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>)
+  %2 = fir.alloca i32 {bindc_name = "k", uniq_name = "_QFtestEk"}
+  %3:2 = hlfir.declare %2 {uniq_name = "_QFtestEk"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+  %4 = fir.alloca i32 {bindc_name = "l", uniq_name = "_QFtestEl"}
+  %5:2 = hlfir.declare %4 {uniq_name = "_QFtestEl"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+  %6 = fir.address_of(@_QFtestECn) : !fir.ref<i32>
+  %7:2 = hlfir.declare %6 {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtestECn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+  %8:2 = hlfir.declare %arg0 {uniq_name = "_QFtestEpi"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+  %9 = fir.shape %c2 : (index) -> !fir.shape<1>
+  %10 = hlfir.elemental %9 : (!fir.shape<1>) -> !hlfir.expr<2xf32> {
+  ^bb0(%arg2: index):
+    %11 = fir.shape %c2 : (index) -> !fir.shape<1>
+    %12 = hlfir.elemental %11 : (!fir.shape<1>) -> !hlfir.expr<2xf32> {
+    ^bb0(%arg3: index):
+      %17 = fir.load %8#0 : !fir.ref<f32>
+      hlfir.yield_element %17 : f32
+    }
+    %13:3 = hlfir.associate %12(%11) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<2xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>, i1)
+    %14 = fir.embox %13#0(%11) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
+    %15 = fir.convert %14 : (!fir.box<!fir.array<2xf32>>) -> !fir.box<!fir.array<?xf32>>
+    %16 = fir.call @_QPfoo(%15) fastmath<contract> : (!fir.box<!fir.array<?xf32>>) -> f32
+    hlfir.end_associate %13#1, %13#2 : !fir.ref<!fir.array<2xf32>>, i1
+    hlfir.destroy %12 : !hlfir.expr<2xf32>
+    hlfir.yield_element %16 : f32
+  }
+  hlfir.assign %10 to %1#0 : !hlfir.expr<2xf32>, !fir.ref<!fir.array<2xf32>>
+  hlfir.destroy %10 : !hlfir.expr<2xf32>
+  return
+}
+fir.global internal @_QFtestECn constant : i32 {
+  %c2_i32 = arith.constant 2 : i32
+  fir.has_value %c2_i32 : i32
+}
+func.func private @_QPfoo(!fir.box<!fir.array<?xf32>>) -> f32

flang/test/Lower/HLFIR/array-ctor-as-elemental-nested.f90

+! Test lowering of nested array constructors as hlfir.elemental.
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+! hlfir.end_associate and hlfir.destroy used to be generated
+! after hlfir.yield_element for the outermost hlfir.elemental.
+
+! CHECK-LABEL:   func.func @_QPtest(
+! CHECK-SAME:                       %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "pi"},
+! CHECK-SAME:                       %[[VAL_1:.*]]: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "h1"}) {
+! CHECK:           %[[VAL_2:.*]] = arith.constant 2 : index
+! CHECK:           %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_3]]) {uniq_name = "_QFtestEh1"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>)
+! CHECK:           %[[VAL_5:.*]] = fir.alloca i32 {bindc_name = "k", uniq_name = "_QFtestEk"}
+! CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {uniq_name = "_QFtestEk"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:           %[[VAL_7:.*]] = fir.alloca i32 {bindc_name = "l", uniq_name = "_QFtestEl"}
+! CHECK:           %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] {uniq_name = "_QFtestEl"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:           %[[VAL_9:.*]] = fir.address_of(@_QFtestECn) : !fir.ref<i32>
+! CHECK:           %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtestECn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:           %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtestEpi"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_12:.*]] = arith.constant 2 : index
+! CHECK:           %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_14:.*]] = hlfir.elemental %[[VAL_13]] : (!fir.shape<1>) -> !hlfir.expr<2xf32> {
+! CHECK:           ^bb0(%[[VAL_15:.*]]: index):
+! CHECK:             %[[VAL_16:.*]] = arith.constant 2 : index
+! CHECK:             %[[VAL_17:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1>
+! CHECK:             %[[VAL_18:.*]] = hlfir.elemental %[[VAL_17]] : (!fir.shape<1>) -> !hlfir.expr<2xf32> {
+! CHECK:             ^bb0(%[[VAL_19:.*]]: index):
+! CHECK:               %[[VAL_20:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref<f32>
+! CHECK:               hlfir.yield_element %[[VAL_20]] : f32
+! CHECK:             }
+! CHECK:             %[[VAL_21:.*]]:3 = hlfir.associate %[[VAL_22:.*]](%[[VAL_17]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<2xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>, i1)
+! CHECK:             %[[VAL_23:.*]] = fir.embox %[[VAL_21]]#0(%[[VAL_17]]) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
+! CHECK:             %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.box<!fir.array<2xf32>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:             %[[VAL_25:.*]] = fir.call @_QPfoo(%[[VAL_24]]) fastmath<contract> : (!fir.box<!fir.array<?xf32>>) -> f32
+! CHECK:             hlfir.end_associate %[[VAL_21]]#1, %[[VAL_21]]#2 : !fir.ref<!fir.array<2xf32>>, i1
+! CHECK:             hlfir.destroy %[[VAL_22]] : !hlfir.expr<2xf32>
+! CHECK:             hlfir.yield_element %[[VAL_25]] : f32
+! CHECK:           }
+! CHECK:           hlfir.assign %[[VAL_26:.*]] to %[[VAL_4]]#0 : !hlfir.expr<2xf32>, !fir.ref<!fir.array<2xf32>>
+! CHECK:           hlfir.destroy %[[VAL_26]] : !hlfir.expr<2xf32>
+! CHECK:           return
+! CHECK:         }
+subroutine test(pi,h1)
+  implicit none
+  integer, parameter :: N = 2
+  interface
+     pure real function foo(x)
+       real, intent(in) :: x(:)
+     end function foo
+  end interface
+  real h1(1:N)
+  integer k, l
+  real pi
+  h1 = (/(foo((/(pi,l=1,N)/)),k=1,N)/)
+end subroutine test