[flang] Implement codegen of hlfir.designate with component refs

[jeanPerier]

Summary

Lower all the different kinds of hlfir.designate component refs to
FIR.

Depends on D141470

[clementval]

LGTM

flang/lib/Optimizer/Builder/HLFIRTools.cpp

 mlir::Value hlfir::genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
                                  hlfir::Entity entity) {
   llvm::SmallVector<mlir::Value, 1> lenParams;
   genLengthParameters(loc, builder, entity, lenParams);
   assert(lenParams.size() == 1 && "characters must have one length parameters");
   return lenParams[0];
 }
 
+// Return a "shape" that can be used in fir.embox/fir.rebox with \p exv base.
+static mlir::Value asEmboxShape(mlir::Location loc, fir::FirOpBuilder &builder,
+                                const fir::ExtendedValue &exv,
+                                mlir::Value shape) {
+  if (!shape)
+    return shape;
+  // fir.rebox does not need and does not accept extents (fir.shape or
+  // fir.shape_shift) since this information is already in the input fir.box,
+  // it only accepts fir.shift because local lower bounds may not be reflected
+  // in the fir.box.
+  if (fir::getBase(exv).getType().isa<fir::BaseBoxType>() &&
+      !shape.getType().isa<fir::ShiftType>())
+    return builder.createShape(loc, exv);
+  return shape;
+}
+
 std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(
     mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
     llvm::SmallVectorImpl<mlir::Value> &typeParams) {
   auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
   assert(!cleanup && "variable to Exv should not produce cleanup");
   if (entity.hasLengthParameters()) {
     auto params = fir::getTypeParams(exv);
     typeParams.append(params.begin(), params.end());
   }
   if (entity.isScalar())
     return {fir::getBase(exv), mlir::Value{}};
   if (auto variableInterface = entity.getIfVariableInterface())
-    return {fir::getBase(exv), variableInterface.getShape()};
+    return {fir::getBase(exv),
+            asEmboxShape(loc, builder, exv, variableInterface.getShape())};
   return {fir::getBase(exv), builder.createShape(loc, exv)};
 }
 
 hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
                                                   fir::FirOpBuilder &builder,
                                                   Entity entity) {
   if (entity.isMutableBox())
     return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity).getResult()};

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

public:
 
   mlir::LogicalResult
   matchAndRewrite(hlfir::DesignateOp designate,
                   mlir::PatternRewriter &rewriter) const override {
     mlir::Location loc = designate.getLoc();
     auto module = designate->getParentOfType<mlir::ModuleOp>();
     fir::FirOpBuilder builder(rewriter, fir::getKindMapping(module));
 
-    if (designate.getComponent() || designate.getComplexPart())
-      TODO(loc, "hlfir::designate with complex part or component");
+    if (designate.getComplexPart())
+      TODO(loc, "hlfir::designate with complex part");
 
     hlfir::Entity baseEntity(designate.getMemref());
+
     if (baseEntity.isMutableBox())
       TODO(loc, "hlfir::designate load of pointer or allocatable");
 
     mlir::Type designateResultType = designate.getResult().getType();
     llvm::SmallVector<mlir::Value> firBaseTypeParameters;
     auto [base, shape] = hlfir::genVariableFirBaseShapeAndParams(
         loc, builder, baseEntity, firBaseTypeParameters);
-    if (designateResultType.isa<fir::BoxType>()) {
+    mlir::Type baseEleTy = hlfir::getFortranElementType(base.getType());
+
+    mlir::Value fieldIndex;
+    if (designate.getComponent()) {
+      mlir::Type baseRecordType = baseEntity.getFortranElementType();
+      if (fir::isRecordWithTypeParameters(baseRecordType))
+        TODO(loc, "hlfir.designate with a parametrized derived type base");
+      fieldIndex = builder.create<fir::FieldIndexOp>(
+          loc, fir::FieldType::get(builder.getContext()),
+          designate.getComponent().value(), baseRecordType,
+          /*typeParams=*/mlir::ValueRange{});
+      if (baseEntity.isScalar()) {
+        // Component refs of scalar base right away:
+        // - scalar%scalar_component [substring|complex_part] or
+        // - scalar%static_size_array_comp
+        // - scalar%array(indices) [substring| complex part]
+        mlir::Type componentType = baseEleTy.cast<fir::RecordType>().getType(
+            designate.getComponent().value());
+        if (componentType.isa<fir::BaseBoxType>())
+          TODO(loc,
+               "addressing parametrized derived type automatic components");
+        mlir::Type coorTy = fir::ReferenceType::get(componentType);
+        base = builder.create<fir::CoordinateOp>(loc, coorTy, base, fieldIndex);
+        baseEleTy = hlfir::getFortranElementType(componentType);
+        shape = designate.getComponentShape();
+      } else {
+        // array%component[(indices) substring|complex part] cases.
+        // Component ref of array bases are dealt with below in embox/rebox.
+        assert(designateResultType.isa<fir::BaseBoxType>());
+      }
+    }
+
+    if (designateResultType.isa<fir::BaseBoxType>()) {
       // Generate embox or rebox.
-      if (designate.getIndices().empty())
-        TODO(loc, "hlfir::designate whole part");
-      // Otherwise, this is an array section with triplets.
+      if (!fir::unwrapPassByRefType(designateResultType)
+               .isa<fir::SequenceType>())
+        TODO(loc, "addressing polymorphic arrays");
       llvm::SmallVector<mlir::Value> triples;
-      auto undef = builder.create<fir::UndefOp>(loc, builder.getIndexType());
+      llvm::SmallVector<mlir::Value> sliceFields;
+      mlir::Type idxTy = builder.getIndexType();
       auto subscripts = designate.getIndices();
+      if (fieldIndex && baseEntity.isArray()) {
+        // array%scalar_comp or array%array_comp(indices)
+        // Generate triples for array(:, :, ...).
+        auto one = builder.createIntegerConstant(loc, idxTy, 1);
+        for (auto [lb, ub] : hlfir::genBounds(loc, builder, baseEntity)) {
+          triples.push_back(builder.createConvert(loc, idxTy, lb));
+          triples.push_back(builder.createConvert(loc, idxTy, ub));
+          triples.push_back(one);
+        }
+        sliceFields.push_back(fieldIndex);
+        // Add indices in the field path for "array%array_comp(indices)"
+        // case.
+        sliceFields.append(subscripts.begin(), subscripts.end());
+      } else {
+        // Otherwise, this is an array section with triplets.
+        auto undef = builder.create<fir::UndefOp>(loc, idxTy);
         unsigned i = 0;
         for (auto isTriplet : designate.getIsTriplet()) {
           triples.push_back(subscripts[i++]);
           if (isTriplet) {
             triples.push_back(subscripts[i++]);
             triples.push_back(subscripts[i++]);
           } else {
             triples.push_back(undef);
             triples.push_back(undef);
           }
         }
+      }
       llvm::SmallVector<mlir::Value, 2> substring;
       if (!designate.getSubstring().empty()) {
         substring.push_back(designate.getSubstring()[0]);
         mlir::Type idxTy = builder.getIndexType();
         // fir.slice op substring expects the zero based lower bound.
         mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
         substring[0] = builder.createConvert(loc, idxTy, substring[0]);
         substring[0] =
             builder.create<mlir::arith::SubIOp>(loc, substring[0], one);
         substring.push_back(designate.getTypeparams()[0]);
       }
 
-      mlir::Value slice = builder.create<fir::SliceOp>(
-          loc, triples, /*fields=*/mlir::ValueRange{}, substring);
+      mlir::Value slice;
+      if (!triples.empty())
+        slice =
+            builder.create<fir::SliceOp>(loc, triples, sliceFields, substring);
+      else
+        assert(sliceFields.empty() && substring.empty());
       llvm::SmallVector<mlir::Type> resultType{designateResultType};
       mlir::Value resultBox;
-      if (base.getType().isa<fir::BoxType>())
+      if (base.getType().isa<fir::BaseBoxType>())
         resultBox =
             builder.create<fir::ReboxOp>(loc, resultType, base, shape, slice);
       else
         resultBox = builder.create<fir::EmboxOp>(loc, resultType, base, shape,
                                                  slice, firBaseTypeParameters);
       rewriter.replaceOp(designate, resultBox);
       return mlir::success();
     }
 
-    // Otherwise, the result is the address of a scalar. The base may be an
-    // array, or a scalar.
+    // Otherwise, the result is the address of a scalar, or the address of the
+    // first element of a contiguous array section with compile time constant
+    // shape. The base may be an array, or a scalar.
     mlir::Type resultAddressType = designateResultType;
     if (auto boxCharType = designateResultType.dyn_cast<fir::BoxCharType>())
       resultAddressType = fir::ReferenceType::get(boxCharType.getEleTy());
 
     // Array element indexing.
     if (!designate.getIndices().empty()) {
-      auto eleTy = hlfir::getFortranElementType(base.getType());
-      auto arrayCoorType = fir::ReferenceType::get(eleTy);
-      base = builder.create<fir::ArrayCoorOp>(loc, arrayCoorType, base, shape,
-                                              /*slice=*/mlir::Value{},
-                                              designate.getIndices(),
-                                              firBaseTypeParameters);
+      // - array(indices) [substring|complex_part] or
+      // - scalar%array_comp(indices) [substring|complex_part]
+      // This may be a ranked contiguous array section in which case
+      // The first element address is being computed.
+      llvm::SmallVector<mlir::Value> firstElementIndices;
+      auto indices = designate.getIndices();
+      int i = 0;
+      for (auto isTriplet : designate.getIsTripletAttr().asArrayRef()) {
+        // Coordinate of the first element are the index and triplets lower
+        // bounds
+        firstElementIndices.push_back(indices[i]);
+        i = i + (isTriplet ? 3 : 1);
+      }
+      mlir::Type arrayCoorType = fir::ReferenceType::get(baseEleTy);
+      base = builder.create<fir::ArrayCoorOp>(
+          loc, arrayCoorType, base, shape,
+          /*slice=*/mlir::Value{}, firstElementIndices, firBaseTypeParameters);
     }
 
-    // Scalar substring (potentially on the previously built array element).
+    // Scalar substring (potentially on the previously built array element or
+    // component reference).
     if (!designate.getSubstring().empty())
       base = fir::factory::CharacterExprHelper{builder, loc}.genSubstringBase(
           base, designate.getSubstring()[0], resultAddressType);
 
     // Cast/embox the computed scalar address if needed.
     if (designateResultType.isa<fir::BoxCharType>()) {
       assert(designate.getTypeparams().size() == 1 &&
              "must have character length");

flang/test/HLFIR/designate-codegen-component-refs.fir

+// Test code generation to FIR of hlfir.designate operations
+// with component reference.
+// RUN: fir-opt %s -convert-hlfir-to-fir | FileCheck %s
+
+func.func @test_scalar(%arg0: !fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "a"} : (!fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>) -> (!fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>, !fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>)
+  %1 = hlfir.designate %0#0{"scalar_x"}   : (!fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>) -> !fir.ref<f32>
+  return
+}
+// CHECK-LABEL:   func.func @test_scalar(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>) {
+// CHECK:  %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "a"}
+// CHECK:  %[[VAL_2:.*]] = fir.field_index scalar_x, !fir.type<t1{scalar_i:i32,scalar_x:f32}>
+// CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.type<t1{scalar_i:i32,scalar_x:f32}>>, !fir.field) -> !fir.ref<f32>
+
+func.func @test_array_char_comp_1(%arg0: !fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "a"} : (!fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>) -> (!fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>, !fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>)
+  %c10 = arith.constant 10 : index
+  %c20 = arith.constant 20 : index
+  %1 = fir.shape %c10, %c20 : (index, index) -> !fir.shape<2>
+  %c5 = arith.constant 5 : index
+  %2 = hlfir.designate %0#0{"array_char_comp"}   shape %1 typeparams %c5 : (!fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>, !fir.shape<2>, index) -> !fir.ref<!fir.array<10x20x!fir.char<1,5>>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array_char_comp_1(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>) {
+// CHECK:  %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "a"}
+// CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 20 : index
+// CHECK:  %[[VAL_4:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_5:.*]] = arith.constant 5 : index
+// CHECK:  %[[VAL_6:.*]] = fir.field_index array_char_comp, !fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>
+// CHECK:  %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref<!fir.type<t_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>, !fir.field) -> !fir.ref<!fir.array<10x20x!fir.char<1,5>>>
+
+func.func @test_array(%arg0: !fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "a"} : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>) -> (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>, !fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>)
+  %c0 = arith.constant 0 : index
+  %4:3 = fir.box_dims %0#0, %c0 : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>, index) -> (index, index, index)
+  %5 = fir.shape %4#1 : (index) -> !fir.shape<1>
+  %6 = hlfir.designate %0#0{"scalar_x"}   shape %5 : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>) {
+// CHECK:  %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "a"}
+// CHECK:  %[[VAL_2:.*]] = fir.rebox %[[VAL_1]] : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>) -> !fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>
+// CHECK:  %[[VAL_3:.*]] = arith.constant 0 : index
+// CHECK:  %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>, index) -> (index, index, index)
+// CHECK:  %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1>
+// CHECK:  %[[VAL_6:.*]] = fir.field_index scalar_x, !fir.type<t1{scalar_i:i32,scalar_x:f32}>
+// CHECK:  %[[VAL_7:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_8:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_9:.*]] = arith.constant 0 : index
+// CHECK:  %[[VAL_10:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_9]] : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>, index) -> (index, index, index)
+// CHECK:  %[[VAL_11:.*]] = fir.slice %[[VAL_8]], %[[VAL_10]]#1, %[[VAL_7]] path %[[VAL_6]] : (index, index, index, !fir.field) -> !fir.slice<1>
+// CHECK:  %[[VAL_12:.*]] = fir.rebox %[[VAL_1]] {{\[}}%[[VAL_11]]] : (!fir.box<!fir.array<?x!fir.type<t1{scalar_i:i32,scalar_x:f32}>>>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
+
+func.func @test_array_char(%arg0: !fir.ref<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, %n : index) {
+  %5 = fir.shape %n : (index) -> !fir.shape<1>
+  %6:2 = hlfir.declare %arg0(%5) {uniq_name = "a"} : (!fir.ref<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>) -> (!fir.box<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.ref<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>)
+  %c5 = arith.constant 5 : index
+  %10 = hlfir.designate %6#0{"scalar_char"}   shape %5 typeparams %c5 : (!fir.box<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,5>>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array_char(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>,
+// CHECK-SAME:    %[[VAL_1:.*]]: index) {
+// CHECK:  %[[VAL_8:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+// CHECK:  %[[VAL_9:.*]] = fir.declare %[[VAL_0]](%[[VAL_8]]) {uniq_name = "a"}
+// CHECK:  %[[VAL_10:.*]] = fir.embox %[[VAL_9]](%[[VAL_8]]) : (!fir.ref<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>) -> !fir.box<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>
+// CHECK:  %[[VAL_11:.*]] = arith.constant 5 : index
+// CHECK:  %[[VAL_12:.*]] = fir.field_index scalar_char, !fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>
+// CHECK:  %[[VAL_13:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_14:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_15:.*]] = fir.slice %[[VAL_14]], %[[VAL_1]], %[[VAL_13]] path %[[VAL_12]] : (index, index, index, !fir.field) -> !fir.slice<1>
+// CHECK:  %[[VAL_16:.*]] = fir.embox %[[VAL_9]](%[[VAL_8]]) {{\[}}%[[VAL_15]]] : (!fir.ref<!fir.array<?x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.char<1,5>>>
+
+func.func @test_array_char_substring(%arg0: !fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>) {
+  %c100 = arith.constant 100 : index
+  %0 = fir.shape %c100 : (index) -> !fir.shape<1>
+  %1:2 = hlfir.declare %arg0(%0) {uniq_name = "a"} : (!fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>)
+  %c3 = arith.constant 3 : index
+  %c5 = arith.constant 5 : index
+  %c3_0 = arith.constant 3 : index
+  %5 = hlfir.designate %1#0{"scalar_char"}  substr %c3, %c5  shape %0 typeparams %c3_0 : (!fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<100x!fir.char<1,3>>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array_char_substring(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 100 : index
+// CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+// CHECK:  %[[VAL_3:.*]] = fir.declare %[[VAL_0]](%[[VAL_2]]) {uniq_name = "a"}
+// CHECK:  %[[VAL_4:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_5:.*]] = arith.constant 5 : index
+// CHECK:  %[[VAL_6:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_7:.*]] = fir.field_index scalar_char, !fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>
+// CHECK:  %[[VAL_8:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_9:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_10:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_11:.*]] = arith.subi %[[VAL_4]], %[[VAL_10]] : index
+// CHECK:  %[[VAL_12:.*]] = fir.slice %[[VAL_9]], %[[VAL_1]], %[[VAL_8]] path %[[VAL_7]] substr %[[VAL_11]], %[[VAL_6]] : (index, index, index, !fir.field, index, index) -> !fir.slice<1>
+// CHECK:  %[[VAL_13:.*]] = fir.embox %[[VAL_3]](%[[VAL_2]]) {{\[}}%[[VAL_12]]] : (!fir.ref<!fir.array<100x!fir.type<t_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<100x!fir.char<1,3>>>
+
+func.func @test_array_array_comp_1(%arg0: !fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>) {
+  %c100 = arith.constant 100 : index
+  %0 = fir.shape %c100 : (index) -> !fir.shape<1>
+  %1:2 = hlfir.declare %arg0(%0) {uniq_name = "a"} : (!fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, !fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>)
+  %c10 = arith.constant 10 : index
+  %c20 = arith.constant 20 : index
+  %5 = fir.shape %c10, %c20 : (index, index) -> !fir.shape<2>
+  %c4 = arith.constant 4 : index
+  %c5 = arith.constant 5 : index
+  %6 = hlfir.designate %1#0{"array_comp"} <%5> (%c4, %c5)  shape %0 : (!fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, !fir.shape<2>, index, index, !fir.shape<1>) -> !fir.box<!fir.array<100xf32>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array_array_comp_1(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 100 : index
+// CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+// CHECK:  %[[VAL_3:.*]] = fir.declare %[[VAL_0]](%[[VAL_2]]) {uniq_name = "a"}
+// CHECK:  %[[VAL_4:.*]] = arith.constant 10 : index
+// CHECK:  %[[VAL_5:.*]] = arith.constant 20 : index
+// CHECK:  %[[VAL_6:.*]] = fir.shape %[[VAL_4]], %[[VAL_5]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_7:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_8:.*]] = arith.constant 5 : index
+// CHECK:  %[[VAL_9:.*]] = fir.field_index array_comp, !fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>
+// CHECK:  %[[VAL_10:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_11:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_12:.*]] = fir.slice %[[VAL_11]], %[[VAL_1]], %[[VAL_10]] path %[[VAL_9]], %[[VAL_7]], %[[VAL_8]] : (index, index, index, !fir.field, index, index) -> !fir.slice<1>
+// CHECK:  %[[VAL_13:.*]] = fir.embox %[[VAL_3]](%[[VAL_2]]) {{\[}}%[[VAL_12]]] : (!fir.ref<!fir.array<100x!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<100xf32>>
+
+func.func @test_array_comp_slice(%arg0: !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "ga"} : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) -> (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>)
+  %c10 = arith.constant 10 : index
+  %c20 = arith.constant 20 : index
+  %1 = fir.shape %c10, %c20 : (index, index) -> !fir.shape<2>
+  %c1 = arith.constant 1 : index
+  %c4 = arith.constant 4 : index
+  %c17 = arith.constant 17 : index
+  %2 = fir.shape %c10, %c17 : (index, index) -> !fir.shape<2>
+  %3 = hlfir.designate %0#0{"array_comp"} <%1> (%c1:%c10:%c1, %c4:%c20:%c1)  shape %2 : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.shape<2>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref<!fir.array<10x17xf32>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array_comp_slice(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) {
+// CHECK:  %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "ga"} : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) -> !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>
+// CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 20 : index
+// CHECK:  %[[VAL_4:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_5:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_6:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_7:.*]] = arith.constant 17 : index
+// CHECK:  %[[VAL_8:.*]] = fir.shape %[[VAL_2]], %[[VAL_7]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_9:.*]] = fir.field_index array_comp, !fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>
+// CHECK:  %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.field) -> !fir.ref<!fir.array<10x20xf32>>
+// CHECK:  %[[VAL_11:.*]] = fir.array_coor %[[VAL_10]](%[[VAL_4]]) %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.array<10x20xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32>
+// CHECK:  %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<f32>) -> !fir.ref<!fir.array<10x17xf32>>
+
+
+func.func @test_array_comp_non_contiguous_slice(%arg0: !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "ga"} : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) -> (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>)
+  %c10 = arith.constant 10 : index
+  %c20 = arith.constant 20 : index
+  %4 = fir.shape %c10, %c20 : (index, index) -> !fir.shape<2>
+  %c1 = arith.constant 1 : index
+  %c6 = arith.constant 6 : index
+  %c4 = arith.constant 4 : index
+  %c17 = arith.constant 17 : index
+  %5 = fir.shape %c6, %c17 : (index, index) -> !fir.shape<2>
+  %6 = hlfir.designate %0#0{"array_comp"} <%4> (%c1:%c6:%c1, %c4:%c20:%c1)  shape %5 : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.shape<2>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.box<!fir.array<6x17xf32>>
+  return
+}
+// CHECK-LABEL:   func.func @test_array_comp_non_contiguous_slice(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) {
+// CHECK:  %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "ga"} : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>) -> !fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>
+// CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 20 : index
+// CHECK:  %[[VAL_4:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_5:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_6:.*]] = arith.constant 6 : index
+// CHECK:  %[[VAL_7:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_8:.*]] = arith.constant 17 : index
+// CHECK:  %[[VAL_9:.*]] = fir.shape %[[VAL_6]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_10:.*]] = fir.field_index array_comp, !fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>
+// CHECK:  %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_10]] : (!fir.ref<!fir.type<t_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.field) -> !fir.ref<!fir.array<10x20xf32>>
+// CHECK:  %[[VAL_12:.*]] = fir.undefined index
+// CHECK:  %[[VAL_13:.*]] = fir.slice %[[VAL_5]], %[[VAL_6]], %[[VAL_5]], %[[VAL_7]], %[[VAL_3]], %[[VAL_5]] : (index, index, index, index, index, index) -> !fir.slice<2>
+// CHECK:  %[[VAL_14:.*]] = fir.embox %[[VAL_11]](%[[VAL_4]]) {{\[}}%[[VAL_13]]] : (!fir.ref<!fir.array<10x20xf32>>, !fir.shape<2>, !fir.slice<2>) -> !fir.box<!fir.array<6x17xf32>>

flang/test/HLFIR/designate-codegen.fir

-// Test hlfir.designate operation code generation to FIR
+// Test code generation to FIR of hlfir.designate operations
+// without component reference.
 // RUN: fir-opt %s -convert-hlfir-to-fir | FileCheck %s
 
 func.func @array_ref(%arg0: !fir.box<!fir.array<?xf32>>, %arg1: !fir.ref<i64>) {
   %0:2 = hlfir.declare %arg1 {uniq_name = "n"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
   %1:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
   %2 = fir.load %0#0 : !fir.ref<i64>
   %3 = hlfir.designate %1#0 (%2)  : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
   return