[flang] Lower component-ref to hlfir.designate

[jeanPerier]

Summary

Implement the visit of component refs in DesignatorBuilder.
The ArrayRef code has to be updated a bit to cope with the
case where the base is an array and the component is also an
array.

Improve the result type of array sections designators (only return
a fir.box if the array section is not contiguous/has dynamic extent).
This required exposing IsContiguous entry point for different
front-end designator nodes (the implementation already existed,
but was internal to check-expression.cpp).

[PeteSteinfeld]

A few nits and questions, but my build failed and should be fixed.

flang/include/flang/Optimizer/Builder/HLFIRTools.h

228

Should read "is not allowed"

flang/lib/Lower/ConvertExprToHLFIR.cpp

110

Should read "need a fir.box"

385–389

Shouldn't this function be checking the value of the lower bound?

426–503

This sentence is a little awkward. Does this work -- "Called from contexts where the component is expected to be the base of an ArrayRef."?

449

"compute" should read "computes".

451

Did you leave something out here? The sentence "This entry points allows." seems incomplete.

flang/lib/Optimizer/Builder/HLFIRTools.cpp

348–349

When I build this code, I get a compilation error here. I'm using GCC 9.3.0. Here's the relevant excerpt from the build's log file:

/local/home/psteinfeld/main/cref/flang/lib/Optimizer/Builder/HLFIRTools.cpp: In function ‘llvm::SmallVector<std::pair<mlir::Value, mlir::Value> > hlfir::genBounds(mlir::Location, fir::FirOpBuilder&, mlir::Value)’:
/local/home/psteinfeld/main/cref/flang/lib/Optimizer/Builder/HLFIRTools.cpp:349:48: error: suggest parentheses around ‘&&’ within ‘||’ [-Werror=parentheses]
  349 |          shape.getType().isa<fir::ShapeType>() && "shape must contain extents");
      |          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
At global scope:
cc1plus: error: unrecognized command line option ‘-Wno-ctad-maybe-unsupported’ [-Werror]
cc1plus: all warnings being treated as errors

[clementval]

LGTM

[jeanPerier]

Fix warning caught by Pete's build and rephrase some comments
as suggested (thanks Pete!).

[jeanPerier]

In D141470#4043709, @PeteSteinfeld wrote:

A few nits and questions, but my build failed and should be fixed.

Thanks @PeteSteinfeld, I rephrased the comments and the warning should be gone.

flang/lib/Lower/ConvertExprToHLFIR.cpp

385–389

You mean, to check that they are not all ones ?

No, this was already done when generating the fir.shift/fir.shape_shift (either here via the hasNonDefaultLowerBounds that checks for the value for component array lower bounds (when possible of course), or when converting symbols specification expression at [1] before lowering the subprogram body). Worst case, it is not a correctness issue to do computation with lower bounds that are all ones.

[1] https://github.com/llvm/llvm-project/blob/b71bbbb64ff92184e13a793b71982df4cdee0271/flang/lib/Lower/ConvertVariable.cpp#L1192

426–503

Thanks, I meant the reverse. I rephrased your suggestion to "Called from contexts where the component is not the base of an ArrayRef."

451

Whoops. Rephrased to: "The result shape will be computed after processing a following ArrayRef, if any, and in "visit" otherwise."

[PeteSteinfeld]

Thanks, Jean!

All builds and tests correctly and looks good.

flang/include/flang/Evaluate/check-expression.h

extern template void CheckSpecificationExpr(
     const std::optional<Expr<SubscriptInteger>> &x, const semantics::Scope &,
     FoldingContext &);
 
 // Contiguity & "simple contiguity" (9.5.4)
 template <typename A>
 std::optional<bool> IsContiguous(const A &, FoldingContext &);
 extern template std::optional<bool> IsContiguous(
     const Expr<SomeType> &, FoldingContext &);
+extern template std::optional<bool> IsContiguous(
+    const ArrayRef &, FoldingContext &);
+extern template std::optional<bool> IsContiguous(
+    const Substring &, FoldingContext &);
+extern template std::optional<bool> IsContiguous(
+    const Component &, FoldingContext &);
+extern template std::optional<bool> IsContiguous(
+    const ComplexPart &, FoldingContext &);
+extern template std::optional<bool> IsContiguous(
+    const CoarrayRef &, FoldingContext &);
 template <typename A>
 bool IsSimplyContiguous(const A &x, FoldingContext &context) {
   return IsContiguous(x, context).value_or(false);
 }
 
 template <typename A> bool IsErrorExpr(const A &);
 extern template bool IsErrorExpr(const Expr<SomeType> &);
 
 std::optional<parser::Message> CheckStatementFunction(
     const Symbol &, const Expr<SomeType> &, FoldingContext &);
 
 } // namespace Fortran::evaluate
 #endif

flang/include/flang/Optimizer/Builder/HLFIRTools.h

 /// Get element entity(oneBasedIndices) if entity is an array, or return entity
 /// if it is a scalar. The indices are one based. If the entity has non default
 /// lower bounds, the function will adapt the indices in the indexing operation.
 hlfir::Entity getElementAt(mlir::Location loc, fir::FirOpBuilder &builder,
                            Entity entity, mlir::ValueRange oneBasedIndices);
 /// Compute the lower and upper bounds of an entity.
 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
 genBounds(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity);
+/// Compute the lower and upper bounds given a fir.shape or fir.shape_shift
+/// (fir.shift is not allowed here).
+llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
+genBounds(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value shape);
 
 /// Compute fir.shape<> (no lower bounds) for an entity.
 mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder,
                      Entity entity);
 
 /// Generate a vector of extents with index type from a fir.shape
 /// of fir.shape_shift value.
 llvm::SmallVector<mlir::Value> getIndexExtents(mlir::Location loc,

flang/lib/Evaluate/check-expression.cpp

if (IsVariable(x)) {
     return IsContiguousHelper{context}(x);
   } else {
     return true; // not a variable
   }
 }
 
 template std::optional<bool> IsContiguous(
     const Expr<SomeType> &, FoldingContext &);
+template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &);
+template std::optional<bool> IsContiguous(const Substring &, FoldingContext &);
+template std::optional<bool> IsContiguous(const Component &, FoldingContext &);
+template std::optional<bool> IsContiguous(
+    const ComplexPart &, FoldingContext &);
+template std::optional<bool> IsContiguous(const CoarrayRef &, FoldingContext &);
 
 // IsErrorExpr()
 struct IsErrorExprHelper : public AnyTraverse<IsErrorExprHelper, bool> {
   using Result = bool;
   using Base = AnyTraverse<IsErrorExprHelper, Result>;
   IsErrorExprHelper() : Base{*this} {}
   using Base::operator();
 

flang/lib/Lower/ConvertExprToHLFIR.cpp

 
 private:
   /// Struct that is filled while visiting a part-ref (in the "visit" member
   /// function) before the top level "gen" generates an hlfir.declare for the
   /// part ref. It contains the lowered pieces of the part-ref that will
   /// become the operands of an hlfir.declare.
   struct PartInfo {
     fir::FortranVariableOpInterface base;
+    std::string componentName{};
+    mlir::Value componentShape;
     hlfir::DesignateOp::Subscripts subscripts;
     mlir::Value resultShape;
     llvm::SmallVector<mlir::Value> typeParams;
     llvm::SmallVector<mlir::Value, 2> substring;
   };
 
-  /// Generate an hlfir.declare for a part-ref given a filled PartInfo and the
-  /// FIR type for this part-ref.
-  fir::FortranVariableOpInterface genDeclare(mlir::Type resultValueType,
-                                             PartInfo &partInfo) {
-    // Compute hlfir.declare result type.
-    // TODO: ensure polymorphic aspect of base of component  will be
-    // preserved, as well as pointer/allocatable component aspects.
-    mlir::Type resultType;
-    /// Array sections may be non contiguous, so the output must be a box even
-    /// when the extents are static. This can be refined later for cases where
-    /// the output is know to be simply contiguous and that do not have lower
-    /// bounds.
+  // Given the value type of a designator (T or fir.array<T>) and the front-end
+  // node for the designator, compute the memory type (fir.class, fir.ref, or
+  // fir.box)...
+  template <typename T>
+  mlir::Type computeDesignatorType(mlir::Type resultValueType,
+                                   const PartInfo &partInfo,
+                                   const T &designatorNode) {
+    // Dynamic type of polymorphic base must be kept if the designator is
+    // polymorphic.
+    if (isPolymorphic(designatorNode))
+      return fir::ClassType::get(resultValueType);
+    // Character scalar with dynamic length needs a fir.boxchar to hold the
+    // designator length.
     auto charType = resultValueType.dyn_cast<fir::CharacterType>();
     if (charType && charType.hasDynamicLen())
-      resultType =
-          fir::BoxCharType::get(charType.getContext(), charType.getFKind());
-    else if (resultValueType.isa<fir::SequenceType>() ||
-             fir::hasDynamicSize(resultValueType))
-      resultType = fir::BoxType::get(resultValueType);
-    else
-      resultType = fir::ReferenceType::get(resultValueType);
+      return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
+    // Arrays with non default lower bounds or dynamic length or dynamic extent
+    // need a fir.box to hold the dynamic or lower bound information.
+    if (fir::hasDynamicSize(resultValueType) ||
+        hasNonDefaultLowerBounds(partInfo))
+      return fir::BoxType::get(resultValueType);
+    // Non simply contiguous ref require a fir.box to carry the byte stride.
+    if (resultValueType.isa<fir::SequenceType>() &&
+        !Fortran::evaluate::IsSimplyContiguous(
+            designatorNode, getConverter().getFoldingContext()))
+      return fir::BoxType::get(resultValueType);
+    // Other designators can be handled as raw addresses.
+    return fir::ReferenceType::get(resultValueType);
+  }
 
+  template <typename T>
+  static bool isPolymorphic(const T &designatorNode) {
+    if constexpr (!std::is_same_v<T, Fortran::evaluate::Substring>) {
+      return Fortran::semantics::IsPolymorphic(designatorNode.GetLastSymbol());
+    }
+    return false;
+  }
+
+  template <typename T>
+  /// Generate an hlfir.designate for a part-ref given a filled PartInfo and the
+  /// FIR type for this part-ref.
+  fir::FortranVariableOpInterface genDesignate(mlir::Type resultValueType,
+                                               PartInfo &partInfo,
+                                               const T &designatorNode) {
+    mlir::Type designatorType =
+        computeDesignatorType(resultValueType, partInfo, designatorNode);
     std::optional<bool> complexPart;
     auto designate = getBuilder().create<hlfir::DesignateOp>(
-        getLoc(), resultType, partInfo.base.getBase(), "",
-        /*componentShape=*/mlir::Value{}, partInfo.subscripts,
+        getLoc(), designatorType, partInfo.base.getBase(),
+        partInfo.componentName, partInfo.componentShape, partInfo.subscripts,
         partInfo.substring, complexPart, partInfo.resultShape,
         partInfo.typeParams);
     return mlir::cast<fir::FortranVariableOpInterface>(
         designate.getOperation());
   }
 
   fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::SymbolRef &symbolRef) {
     if (std::optional<fir::FortranVariableOpInterface> varDef =
             getSymMap().lookupVariableDefinition(symbolRef))
       return *varDef;
     TODO(getLoc(), "lowering symbol to HLFIR");
   }
 
-  hlfir::EntityWithAttributes
+  fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::Component &component) {
-    TODO(getLoc(), "lowering component to HLFIR");
+    PartInfo partInfo;
+    mlir::Type resultType = visit(component, partInfo);
+    return genDesignate(resultType, partInfo, component);
   }
 
-  hlfir::EntityWithAttributes gen(const Fortran::evaluate::ArrayRef &arrayRef) {
+  fir::FortranVariableOpInterface
+  gen(const Fortran::evaluate::ArrayRef &arrayRef) {
     PartInfo partInfo;
     mlir::Type resultType = visit(arrayRef, partInfo);
-    return genDeclare(resultType, partInfo);
+    return genDesignate(resultType, partInfo, arrayRef);
   }
 
-  hlfir::EntityWithAttributes
+  fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::CoarrayRef &coarrayRef) {
     TODO(getLoc(), "lowering CoarrayRef to HLFIR");
   }
+
   mlir::Type visit(const Fortran::evaluate::CoarrayRef &, PartInfo &) {
     TODO(getLoc(), "lowering CoarrayRef to HLFIR");
   }
 
-  hlfir::EntityWithAttributes
+  fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::ComplexPart &complexPart) {
     TODO(getLoc(), "lowering complex part to HLFIR");
   }
 
-  hlfir::EntityWithAttributes
+  fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::Substring &substring) {
     PartInfo partInfo;
     mlir::Type baseStringType = std::visit(
         [&](const auto &x) { return visit(x, partInfo); }, substring.parent());
     assert(partInfo.typeParams.size() == 1 && "expect base string length");
     // Compute the substring lower and upper bound.
     partInfo.substring.push_back(genSubscript(substring.lower()));
     if (Fortran::evaluate::MaybeExtentExpr upperBound = substring.upper())
if (cstLen) {
       // Compute "len = max(ub-lb+1,0)" (Fortran 2018 9.4.1).
       mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
       auto boundsDiff = builder.create<mlir::arith::SubIOp>(
           loc, partInfo.substring[1], partInfo.substring[0]);
       auto rawLen = builder.create<mlir::arith::AddIOp>(loc, boundsDiff, one);
       partInfo.typeParams[0] =
           fir::factory::genMaxWithZero(builder, loc, rawLen);
     }
-    mlir::Type resultType = changeLengthInCharacterType(
-        loc, baseStringType,
+    auto kind = hlfir::getFortranElementType(baseStringType)
+                    .cast<fir::CharacterType>()
+                    .getFKind();
+    auto newCharTy = fir::CharacterType::get(
+        baseStringType.getContext(), kind,
         cstLen ? *cstLen : fir::CharacterType::unknownLen());
-    return genDeclare(resultType, partInfo);
+    mlir::Type resultType = changeElementType(baseStringType, newCharTy);
+    return genDesignate(resultType, partInfo, substring);
   }
 
-  static mlir::Type changeLengthInCharacterType(mlir::Location loc,
-                                                mlir::Type type,
-                                                int64_t newLen) {
+  static mlir::Type changeElementType(mlir::Type type, mlir::Type newEleTy) {
     return llvm::TypeSwitch<mlir::Type, mlir::Type>(type)
-        .Case<fir::CharacterType>([&](fir::CharacterType charTy) -> mlir::Type {
-          return fir::CharacterType::get(charTy.getContext(), charTy.getFKind(),
-                                         newLen);
-        })
         .Case<fir::SequenceType>([&](fir::SequenceType seqTy) -> mlir::Type {
-          return fir::SequenceType::get(
-              seqTy.getShape(),
-              changeLengthInCharacterType(loc, seqTy.getEleTy(), newLen));
+          return fir::SequenceType::get(seqTy.getShape(), newEleTy);
         })
         .Case<fir::PointerType, fir::HeapType, fir::ReferenceType,
               fir::BoxType>([&](auto t) -> mlir::Type {
           using FIRT = decltype(t);
-          return FIRT::get(
-              changeLengthInCharacterType(loc, t.getEleTy(), newLen));
+          return FIRT::get(changeElementType(t.getEleTy(), newEleTy));
         })
-        .Default([loc](mlir::Type t) -> mlir::Type {
-          fir::emitFatalError(loc, "expected character type");
-        });
+        .Default([newEleTy](mlir::Type t) -> mlir::Type { return newEleTy; });
   }
 
   mlir::Type visit(const Fortran::evaluate::DataRef &dataRef,
                    PartInfo &partInfo) {
     return std::visit([&](const auto &x) { return visit(x, partInfo); },
                       dataRef.u);
   }
 
hlfir::genLengthParameters(getLoc(), getBuilder(), partInfo.base,
                                partInfo.typeParams);
     return partInfo.base.getElementOrSequenceType();
   }
 
   mlir::Type visit(const Fortran::evaluate::ArrayRef &arrayRef,
                    PartInfo &partInfo) {
     mlir::Type baseType;
     if (const auto *component = arrayRef.base().UnwrapComponent())
-      baseType = visit(*component, partInfo);
+      baseType = visitComponentImpl(*component, partInfo).second;
+    else
       baseType = visit(arrayRef.base().GetLastSymbol(), partInfo);
 
     fir::FirOpBuilder &builder = getBuilder();
     mlir::Location loc = getLoc();
     mlir::Type idxTy = builder.getIndexType();
     llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds;
-    auto getBounds = [&](unsigned i) {
-      if (bounds.empty())
+    auto getBaseBounds = [&](unsigned i) {
+      if (bounds.empty()) {
+        if (partInfo.componentName.empty()) {
           bounds = hlfir::genBounds(loc, builder, partInfo.base);
+        } else {
+          assert(
+              partInfo.componentShape &&
+              "implicit array section bounds must come from component shape");
+          bounds = hlfir::genBounds(loc, builder, partInfo.componentShape);
+        }
+        assert(!bounds.empty() &&
+               "failed to compute implicit array section bounds");
+      }
       return bounds[i];
     };
     auto frontEndResultShape =
         Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayRef);
     llvm::SmallVector<mlir::Value> resultExtents;
     fir::SequenceType::Shape resultTypeShape;
     for (auto subscript : llvm::enumerate(arrayRef.subscript())) {
       if (const auto *triplet =
               std::get_if<Fortran::evaluate::Triplet>(&subscript.value().u)) {
         mlir::Value lb, ub;
         if (const auto &lbExpr = triplet->lower())
           lb = genSubscript(*lbExpr);
         else
-          lb = getBounds(subscript.index()).first;
+          lb = getBaseBounds(subscript.index()).first;
         if (const auto &ubExpr = triplet->upper())
           ub = genSubscript(*ubExpr);
         else
-          ub = getBounds(subscript.index()).second;
+          ub = getBaseBounds(subscript.index()).second;
         lb = builder.createConvert(loc, idxTy, lb);
         ub = builder.createConvert(loc, idxTy, ub);
         mlir::Value stride = genSubscript(triplet->stride());
         stride = builder.createConvert(loc, idxTy, stride);
         mlir::Value extent;
         // Use constant extent if possible. The main advantage to do this now
         // is to get the best FIR array types as possible while lowering.
         if (frontEndResultShape)
for (auto subscript : llvm::enumerate(arrayRef.subscript())) {
         partInfo.subscripts.push_back(genSubscript(expr));
       }
     }
 
     assert(resultExtents.size() == resultTypeShape.size() &&
            "inconsistent hlfir.designate shape");
     mlir::Type resultType = baseType.cast<fir::SequenceType>().getEleTy();
     if (!resultTypeShape.empty()) {
+      // Ranked array section. The result shape comes from the array section
+      // subscripts.
       resultType = fir::SequenceType::get(resultTypeShape, resultType);
+      assert(!partInfo.resultShape &&
+             "Fortran designator can only have one ranked part");
       partInfo.resultShape = builder.genShape(loc, resultExtents);
+    } else if (!partInfo.componentName.empty() && partInfo.base.isArray()) {
+      // This is an array%array_comp(indices) reference. Keep the
+      // shape of the base array and not the array_comp.
+      auto compBaseTy = partInfo.base.getElementOrSequenceType();
+      resultType = changeElementType(compBaseTy, resultType);
+      assert(!partInfo.resultShape && "should not have been computed already");
+      partInfo.resultShape = hlfir::genShape(loc, builder, partInfo.base);
     }
     return resultType;
   }
 
+  static bool
+  hasNonDefaultLowerBounds(const Fortran::semantics::Symbol &componentSym) {
+    if (const auto *objDetails =
+            componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>())
+      for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
+        if (auto lb = bounds.lbound().GetExplicit())
+          if (auto constant = Fortran::evaluate::ToInt64(*lb))
+            if (!constant || *constant != 1)
+              return true;
+    return false;
+  }
+  static bool hasNonDefaultLowerBounds(const PartInfo &partInfo) {
+    return partInfo.resultShape &&
+           (partInfo.resultShape.getType().isa<fir::ShiftType>() ||
+            partInfo.resultShape.getType().isa<fir::ShapeShiftType>());
+  }
+
+  mlir::Value genComponentShape(const Fortran::semantics::Symbol &componentSym,
+                                mlir::Type fieldType) {
+    // For pointers and allocatable components, the
+    // shape is deferred and should not be loaded now to preserve
+    // pointer/allocatable aspects.
+    if (componentSym.Rank() == 0 ||
+        Fortran::semantics::IsAllocatableOrPointer(componentSym))
+      return mlir::Value{};
+
+    fir::FirOpBuilder &builder = getBuilder();
+    mlir::Location loc = getLoc();
+    mlir::Type idxTy = builder.getIndexType();
+    llvm::SmallVector<mlir::Value> extents;
+    auto seqTy = hlfir::getFortranElementOrSequenceType(fieldType)
+                     .cast<fir::SequenceType>();
+    for (auto extent : seqTy.getShape())
+      extents.push_back(builder.createIntegerConstant(loc, idxTy, extent));
+    if (!hasNonDefaultLowerBounds(componentSym))
+      return builder.create<fir::ShapeOp>(loc, extents);
+
+    llvm::SmallVector<mlir::Value> lbounds;
+    if (const auto *objDetails =
+            componentSym.detailsIf<Fortran::semantics::ObjectEntityDetails>())
+      for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
+        if (auto lb = bounds.lbound().GetExplicit())
+          if (auto constant = Fortran::evaluate::ToInt64(*lb))
+            lbounds.push_back(
+                builder.createIntegerConstant(loc, idxTy, *constant));
+    assert(extents.size() == lbounds.size() &&
+           "extents and lower bounds must match");
+    return builder.genShape(loc, lbounds, extents);
+  }
+
   mlir::Type visit(const Fortran::evaluate::Component &component,
                    PartInfo &partInfo) {
-    TODO(getLoc(), "lowering component to HLFIR");
+    // Called from contexts where the component is not the base of an ArrayRef.
+    // In these cases, the component cannot be an array if the base is an
+    // array. The code below determines the shape of the component reference if
+    // any.
+    auto [baseType, componentType] = visitComponentImpl(component, partInfo);
+    if (partInfo.base.isArray()) {
+      // For array%scalar_comp, the result shape is
+      // the one of the base. Compute it here. Note that the lower bounds of the
+      // base are not the ones of the resulting reference (that are default
+      // ones).
+      partInfo.resultShape = hlfir::genShape(loc, getBuilder(), partInfo.base);
+      assert(!partInfo.componentShape &&
+             "Fortran designators can only have one ranked part");
+      return changeElementType(baseType, componentType);
+    }
+    // scalar%array_comp or scalar%scalar. In any case the shape of this
+    // part-ref is coming from the component.
+    partInfo.resultShape = partInfo.componentShape;
+    partInfo.componentShape = {};
+    return componentType;
+  }
+
+  // Returns the <BaseType, ComponentType> pair, computes partInfo.base,
+  // partInfo.componentShape and partInfo.typeParams, but does not set the
+  // partInfo.resultShape yet. The result shape will be computed after
+  // processing a following ArrayRef, if any, and in "visit" otherwise.
+  std::pair<mlir::Type, mlir::Type>
+  visitComponentImpl(const Fortran::evaluate::Component &component,
+                     PartInfo &partInfo) {
+    fir::FirOpBuilder &builder = getBuilder();
+    // Break the Designator visit here: if the base is an array-ref, a
+    // coarray-ref, or another component, this creates another hlfir.designate
+    // for it.  hlfir.designate is not meant to represent more than one
+    // part-ref.
+    partInfo.base =
+        std::visit([&](const auto &x) { return gen(x); }, component.base().u);
+    assert(partInfo.typeParams.empty() && "should not have been computed yet");
+    hlfir::genLengthParameters(getLoc(), getBuilder(), partInfo.base,
+                               partInfo.typeParams);
+    mlir::Type baseType = partInfo.base.getElementOrSequenceType();
+
+    // Lower the information about the component (type, length parameters and
+    // shape).
+    const Fortran::semantics::Symbol &componentSym = component.GetLastSymbol();
+    partInfo.componentName = componentSym.name().ToString();
+    auto recordType =
+        hlfir::getFortranElementType(baseType).cast<fir::RecordType>();
+    if (recordType.isDependentType())
+      TODO(getLoc(), "Designate derived type with length parameters in HLFIR");
+    mlir::Type fieldType = recordType.getType(partInfo.componentName);
+    fieldType = hlfir::getFortranElementOrSequenceType(fieldType);
+    partInfo.componentShape = genComponentShape(componentSym, fieldType);
+
+    mlir::Type fieldEleType = hlfir::getFortranElementType(fieldType);
+    if (fir::isRecordWithTypeParameters(fieldEleType))
+      TODO(loc,
+           "lower a component that is a parameterized derived type to HLFIR");
+    if (auto charTy = fieldEleType.dyn_cast<fir::CharacterType>()) {
+      mlir::Location loc = getLoc();
+      mlir::Type idxTy = builder.getIndexType();
+      if (charTy.hasConstantLen())
+        partInfo.typeParams.push_back(
+            builder.createIntegerConstant(loc, idxTy, charTy.getLen()));
+      else if (!Fortran::semantics::IsAllocatableOrPointer(componentSym))
+        TODO(loc, "compute character length of automatic character component "
+                  "in a PDT");
+      // Otherwise, the length of the component is deferred and will only
+      // be read when the component is dereferenced.
+    }
+
+    // For pointers and allocatables, if there is a substring, complex part or
+    // array ref, the designator should be broken here and the pointer or
+    // allocatable dereferenced.
+    if (Fortran::semantics::IsAllocatableOrPointer(componentSym))
+      TODO(loc, "lowering ref to allocatable or pointer component to HLFIR");
+
+    return {baseType, fieldType};
   }
 
   /// Lower a subscript expression. If it is a scalar subscript that is
   /// a variable, it is loaded into an integer value.
   template <typename T>
   hlfir::EntityWithAttributes
   genSubscript(const Fortran::evaluate::Expr<T> &expr);
 
   mlir::Location getLoc() const { return loc; }

flang/lib/Lower/ConvertType.cpp

mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
     derivedTypeInConstruction.emplace_back(typeSymbol, rec);
 
     // Gather the record type fields.
     // (1) The data components.
     for (const auto &field :
          Fortran::semantics::OrderedComponentIterator(tySpec)) {
       // Lowering is assuming non deferred component lower bounds are always 1.
       // Catch any situations where this is not true for now.
-      if (componentHasNonDefaultLowerBounds(field))
+      if (!converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+          componentHasNonDefaultLowerBounds(field))
         TODO(converter.genLocation(field.name()),
              "derived type components with non default lower bounds");
       if (IsProcedure(field))
         TODO(converter.genLocation(field.name()), "procedure components");
       mlir::Type ty = genSymbolType(field);
       // Do not add the parent component (component of the parents are
       // added and should be sufficient, the parent component would
       // duplicate the fields).

flang/lib/Optimizer/Builder/HLFIRTools.cpp

 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "mlir/IR/BlockAndValueMapping.h"
 #include <optional>
 
 // Return explicit extents. If the base is a fir.box, this won't read it to
 // return the extents and will instead return an empty vector.
-static llvm::SmallVector<mlir::Value>
-getExplicitExtents(fir::FortranVariableOpInterface var) {
+static llvm::SmallVector<mlir::Value> getExplicitExtents(mlir::Value shape) {
   llvm::SmallVector<mlir::Value> result;
-  if (mlir::Value shape = var.getShape()) {
-    auto *shapeOp = shape.getDefiningOp();
-    if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
-      auto e = s.getExtents();
-      result.append(e.begin(), e.end());
-    } else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {
-      auto e = s.getExtents();
-      result.append(e.begin(), e.end());
-    } else if (mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {
-      return {};
-    } else {
-      TODO(var->getLoc(), "read fir.shape to get extents");
-    }
+    TODO(shape.getLoc(), "read fir.shape to get extents");
   }
   return result;
 }
+static llvm::SmallVector<mlir::Value>
+getExplicitExtents(fir::FortranVariableOpInterface var) {
+  if (mlir::Value shape = var.getShape())
+    return getExplicitExtents(var.getShape());
+  return {};
+}
 
 // Return explicit lower bounds. For pointers and allocatables, this will not
 // read the lower bounds and instead return an empty vector.
-static llvm::SmallVector<mlir::Value>
-getExplicitLbounds(fir::FortranVariableOpInterface var) {
+static llvm::SmallVector<mlir::Value> getExplicitLbounds(mlir::Value shape) {
   llvm::SmallVector<mlir::Value> result;
-  if (mlir::Value shape = var.getShape()) {
-    auto *shapeOp = shape.getDefiningOp();
-    if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
-      return {};
-    } else if (auto s = mlir::dyn_cast_or_null<fir::ShapeShiftOp>(shapeOp)) {
-      auto e = s.getOrigins();
-      result.append(e.begin(), e.end());
-    } else if (auto s = mlir::dyn_cast_or_null<fir::ShiftOp>(shapeOp)) {
-      auto e = s.getOrigins();
-      result.append(e.begin(), e.end());
-    } else {
-      TODO(var->getLoc(), "read fir.shape to get lower bounds");
-    }
+    TODO(shape.getLoc(), "read fir.shape to get lower bounds");
   }
   return result;
 }
+static llvm::SmallVector<mlir::Value>
+getExplicitLbounds(fir::FortranVariableOpInterface var) {
+  if (mlir::Value shape = var.getShape())
+    return getExplicitLbounds(shape);
+  return {};
+}
 
 static llvm::SmallVector<mlir::Value>
 getExplicitTypeParams(fir::FortranVariableOpInterface var) {
   llvm::SmallVector<mlir::Value> res;
   mlir::OperandRange range = var.getExplicitTypeParams();
   res.append(range.begin(), range.end());
   return res;
 }
for (unsigned dim = 0; dim < exv.rank(); ++dim) {
     mlir::Value extent = fir::factory::readExtent(builder, loc, exv, dim);
     mlir::Value lb = fir::factory::readLowerBound(builder, loc, exv, dim, one);
     mlir::Value ub = genUBound(loc, builder, lb, extent, one);
     result.push_back({lb, ub});
   }
   return result;
 }
 
+llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
+hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
+                 mlir::Value shape) {
+  assert((shape.getType().isa<fir::ShapeShiftType>() ||
+          shape.getType().isa<fir::ShapeType>()) &&
+         "shape must contain extents");
+  auto extents = getExplicitExtents(shape);
+  auto lowers = getExplicitLbounds(shape);
+  assert(lowers.empty() || lowers.size() == extents.size());
+  mlir::Type idxTy = builder.getIndexType();
+  mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+  llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> result;
+  for (auto extent : llvm::enumerate(extents)) {
+    mlir::Value lb = lowers.empty() ? one : lowers[extent.index()];
+    mlir::Value ub = lowers.empty()
+                         ? extent.value()
+                         : genUBound(loc, builder, lb, extent.value(), one);
+    result.push_back({lb, ub});
+  }
+  return result;
+}
+
 static hlfir::Entity followEntitySource(hlfir::Entity entity) {
   while (true) {
     if (auto reassoc = entity.getDefiningOp<hlfir::NoReassocOp>()) {
       entity = hlfir::Entity{reassoc.getVal()};
       continue;
     }
     if (auto asExpr = entity.getDefiningOp<hlfir::AsExprOp>()) {
       entity = hlfir::Entity{asExpr.getVar()};

flang/test/Lower/HLFIR/designators-component-ref.f90

+! Test lowering of component reference to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+module comp_ref
+type t1
+  integer :: scalar_i
+  real :: scalar_x
+end type
+
+type t2
+  integer :: scalar_i2
+  type(t1) :: scalar_t1
+end type
+
+type t_char
+  integer :: scalar_i
+  character(5) :: scalar_char
+end type
+
+type t_array
+  integer :: scalar_i
+  real :: array_comp(10,20)
+end type
+
+type t_array_lbs
+  integer :: scalar_i
+  real :: array_comp_lbs(2:11,3:22)
+end type
+
+type t_array_char
+  integer :: scalar_i
+  character(5) :: array_char_comp(10,20)
+end type
+end module
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                            Test scalar bases                                 !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine test_scalar(a)
+  use comp_ref
+  type(t1) :: a
+  call use_real_scalar(a%scalar_x)
+! CHECK-LABEL: func.func @_QPtest_scalar(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"scalar_x"}   : (!fir.ref<!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>) -> !fir.ref<f32>
+end subroutine
+
+subroutine test_scalar_char(a)
+  use comp_ref
+  type(t_char) :: a
+  call use_char_scalar(a%scalar_char)
+! CHECK-LABEL: func.func @_QPtest_scalar_char(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_2:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"scalar_char"}   typeparams %[[VAL_2]] : (!fir.ref<!fir.type<_QMcomp_refTt_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>, index) -> !fir.ref<!fir.char<1,5>>
+end subroutine
+
+subroutine test_scalar_char_substring(a)
+  use comp_ref
+  type(t_char) :: a
+  call use_char_scalar(a%scalar_char(3:))
+! CHECK-LABEL: func.func @_QPtest_scalar_char_substring(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_2:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_3:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_4:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_5:.*]] = hlfir.designate %[[VAL_1]]#0{"scalar_char"}  substr %[[VAL_2]], %[[VAL_3]]  typeparams %[[VAL_4]] : (!fir.ref<!fir.type<_QMcomp_refTt_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>, index, index, index) -> !fir.ref<!fir.char<1,3>>
+end subroutine
+
+subroutine test_array_comp_1(a)
+  use comp_ref
+  type(t_array) :: a
+  call use_real_array(a%array_comp)
+! CHECK-LABEL: func.func @_QPtest_array_comp_1(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! 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:.*]] = hlfir.designate %[[VAL_1]]#0{"array_comp"}   shape %[[VAL_4]] : (!fir.ref<!fir.type<_QMcomp_refTt_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>, !fir.shape<2>) -> !fir.ref<!fir.array<10x20xf32>>
+end subroutine
+
+subroutine test_array_comp_slice(a)
+  use comp_ref
+  type(t_array) :: a
+  ! Contiguous
+  call use_real_array(a%array_comp(:, 4:20:1))
+! CHECK-LABEL: func.func @_QPtest_array_comp_slice(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! 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 1 : index
+! CHECK:  %[[VAL_7:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_8:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_9:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_10:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 17 : index
+! CHECK:  %[[VAL_12:.*]] = fir.shape %[[VAL_7]], %[[VAL_11]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_13:.*]] = hlfir.designate %[[VAL_1]]#0{"array_comp"} <%[[VAL_4]]> (%[[VAL_5]]:%[[VAL_2]]:%[[VAL_6]], %[[VAL_8]]:%[[VAL_9]]:%[[VAL_10]])  shape %[[VAL_12]] : (!fir.ref<!fir.type<_QMcomp_refTt_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>>
+end subroutine
+
+subroutine test_array_comp_non_contiguous_slice(a)
+  use comp_ref
+  type(t_array) :: a
+  ! Not contiguous
+  print *, a%array_comp(1:6:1, 4:20:1)
+! CHECK-LABEL: func.func @_QPtest_array_comp_non_contiguous_slice(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_7:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_8:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_9:.*]] = fir.shape %[[VAL_7]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_10:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 6 : index
+! CHECK:  %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_13:.*]] = arith.constant 6 : index
+! CHECK:  %[[VAL_14:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_15:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_16:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_17:.*]] = arith.constant 17 : index
+! CHECK:  %[[VAL_18:.*]] = fir.shape %[[VAL_13]], %[[VAL_17]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_19:.*]] = hlfir.designate %[[VAL_1]]#0{"array_comp"} <%[[VAL_9]]> (%[[VAL_10]]:%[[VAL_11]]:%[[VAL_12]], %[[VAL_14]]:%[[VAL_15]]:%[[VAL_16]])  shape %[[VAL_18]] : (!fir.ref<!fir.type<_QMcomp_refTt_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>>
+end subroutine
+
+subroutine test_array_lbs_comp_lbs_1(a)
+  use comp_ref
+  type(t_array_lbs) :: a
+  call use_real_array(a%array_comp_lbs)
+! CHECK-LABEL: func.func @_QPtest_array_lbs_comp_lbs_1(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_3:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_4:.*]] = arith.constant 2 : index
+! CHECK:  %[[VAL_5:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_6:.*]] = fir.shape_shift %[[VAL_4]], %[[VAL_2]], %[[VAL_5]], %[[VAL_3]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK:  %[[VAL_7:.*]] = hlfir.designate %[[VAL_1]]#0{"array_comp_lbs"}   shape %[[VAL_6]] : (!fir.ref<!fir.type<_QMcomp_refTt_array_lbs{scalar_i:i32,array_comp_lbs:!fir.array<10x20xf32>}>>, !fir.shapeshift<2>) -> !fir.box<!fir.array<10x20xf32>>
+end subroutine
+
+subroutine test_array_lbs_comp_lbs_slice(a)
+  use comp_ref
+  type(t_array_lbs) :: a
+  ! Contiguous
+  call use_real_array(a%array_comp_lbs(:, 4:20:1))
+! CHECK-LABEL: func.func @_QPtest_array_lbs_comp_lbs_slice(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_3:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_4:.*]] = arith.constant 2 : index
+! CHECK:  %[[VAL_5:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_6:.*]] = fir.shape_shift %[[VAL_4]], %[[VAL_2]], %[[VAL_5]], %[[VAL_3]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK:  %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_8:.*]] = arith.addi %[[VAL_4]], %[[VAL_2]] : index
+! CHECK:  %[[VAL_9:.*]] = arith.subi %[[VAL_8]], %[[VAL_7]] : index
+! CHECK:  %[[VAL_10:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_12:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_13:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_15:.*]] = arith.constant 17 : index
+! CHECK:  %[[VAL_16:.*]] = fir.shape %[[VAL_11]], %[[VAL_15]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_17:.*]] = hlfir.designate %[[VAL_1]]#0{"array_comp_lbs"} <%[[VAL_6]]> (%[[VAL_4]]:%[[VAL_9]]:%[[VAL_10]], %[[VAL_12]]:%[[VAL_13]]:%[[VAL_14]])  shape %[[VAL_16]] : (!fir.ref<!fir.type<_QMcomp_refTt_array_lbs{scalar_i:i32,array_comp_lbs:!fir.array<10x20xf32>}>>, !fir.shapeshift<2>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref<!fir.array<10x17xf32>>
+end subroutine
+
+subroutine test_array_char_comp_1(a)
+  use comp_ref
+  type(t_array_char) :: a
+  call use_array_char(a%array_char_comp)
+! CHECK-LABEL: func.func @_QPtest_array_char_comp_1(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! 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:.*]] = hlfir.designate %[[VAL_1]]#0{"array_char_comp"}   shape %[[VAL_4]] typeparams %[[VAL_5]] : (!fir.ref<!fir.type<_QMcomp_refTt_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>>>
+end subroutine
+
+subroutine test_array_char_comp_slice(a)
+  use comp_ref
+  type(t_array_char) :: a
+  ! Contiguous
+  call use_array_char(a%array_char_comp(:, 4:20:1))
+! CHECK-LABEL: func.func @_QPtest_array_char_comp_slice(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! 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:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_8:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_9:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_10:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_12:.*]] = arith.constant 17 : index
+! CHECK:  %[[VAL_13:.*]] = fir.shape %[[VAL_8]], %[[VAL_12]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_14:.*]] = hlfir.designate %[[VAL_1]]#0{"array_char_comp"} <%[[VAL_4]]> (%[[VAL_6]]:%[[VAL_2]]:%[[VAL_7]], %[[VAL_9]]:%[[VAL_10]]:%[[VAL_11]])  shape %[[VAL_13]] typeparams %[[VAL_5]] : (!fir.ref<!fir.type<_QMcomp_refTt_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>, !fir.shape<2>, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref<!fir.array<10x17x!fir.char<1,5>>>
+end subroutine
+
+subroutine test_array_char_comp_non_contiguous_slice(a)
+  use comp_ref
+  type(t_array_char) :: a
+  ! Not contiguous
+  print *, a%array_char_comp(1:10:1,1:20:1)(2:4)
+! CHECK-LABEL: func.func @_QPtest_array_char_comp_non_contiguous_slice(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_7:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_8:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_9:.*]] = fir.shape %[[VAL_7]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_10:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_13:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_15:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_16:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_17:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_18:.*]] = fir.shape %[[VAL_13]], %[[VAL_17]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_19:.*]] = arith.constant 2 : index
+! CHECK:  %[[VAL_20:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_21:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_22:.*]] = hlfir.designate %[[VAL_1]]#0{"array_char_comp"} <%[[VAL_9]]> (%[[VAL_10]]:%[[VAL_11]]:%[[VAL_12]], %[[VAL_14]]:%[[VAL_15]]:%[[VAL_16]]) substr %[[VAL_19]], %[[VAL_20]]  shape %[[VAL_18]] typeparams %[[VAL_21]] : (!fir.ref<!fir.type<_QMcomp_refTt_array_char{scalar_i:i32,array_char_comp:!fir.array<10x20x!fir.char<1,5>>}>>, !fir.shape<2>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.box<!fir.array<10x20x!fir.char<1,3>>>
+end subroutine
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                            Test array bases                                  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine test_array(a)
+  use comp_ref
+  type(t1) :: a(:)
+  print *, a%scalar_x
+! CHECK-LABEL: func.func @_QPtest_array(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_9:.*]] = fir.shape %[[VAL_8]]#1 : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_10:.*]] = hlfir.designate %[[VAL_1]]#0{"scalar_x"}   shape %[[VAL_9]] : (!fir.box<!fir.array<?x!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+end subroutine
+
+subroutine test_array_char(a, n)
+  use comp_ref
+  integer(8) :: n
+  type(t_char) :: a(n)
+  print *, a%scalar_char
+! CHECK-LABEL: func.func @_QPtest_array_char(
+! CHECK:  %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_8:[a-z0-9]*]])  {{.*}}Ea
+! CHECK:  %[[VAL_15:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_16:.*]] = hlfir.designate %[[VAL_9]]#0{"scalar_char"}   shape %[[VAL_8]] typeparams %[[VAL_15]] : (!fir.box<!fir.array<?x!fir.type<_QMcomp_refTt_char{scalar_i:i32,scalar_char:!fir.char<1,5>}>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,5>>>
+end subroutine
+
+subroutine test_array_char_substring(a)
+  use comp_ref
+  type(t_char) :: a(100)
+  print *, a%scalar_char(3:)
+! CHECK-LABEL: func.func @_QPtest_array_char_substring(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]])  {{.*}}Ea
+! CHECK:  %[[VAL_9:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_10:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 3 : index
+! CHECK:  %[[VAL_12:.*]] = hlfir.designate %[[VAL_3]]#0{"scalar_char"}  substr %[[VAL_9]], %[[VAL_10]]  shape %[[VAL_2]] typeparams %[[VAL_11]] : (!fir.ref<!fir.array<100x!fir.type<_QMcomp_refTt_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>>>
+end subroutine
+
+subroutine test_array_array_comp_1(a)
+  use comp_ref
+  type(t_array) :: a(100)
+  print *, a%array_comp(4,5)
+! CHECK-LABEL: func.func @_QPtest_array_array_comp_1(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]])  {{.*}}Ea
+! CHECK:  %[[VAL_9:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_10:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_11:.*]] = fir.shape %[[VAL_9]], %[[VAL_10]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_12:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_13:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0{"array_comp"} <%[[VAL_11]]> (%[[VAL_12]], %[[VAL_13]])  shape %[[VAL_2]] : (!fir.ref<!fir.array<100x!fir.type<_QMcomp_refTt_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, !fir.shape<2>, index, index, !fir.shape<1>) -> !fir.box<!fir.array<100xf32>>
+end subroutine
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Test several part ref (produces chain of hlfir.designate)                    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine test_scalar_chain(a)
+  use comp_ref
+  type(t2) :: a
+  call use_real_scalar(a%scalar_t1%scalar_x)
+! CHECK-LABEL: func.func @_QPtest_scalar_chain(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]]  {{.*}}Ea
+! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"scalar_t1"}   : (!fir.ref<!fir.type<_QMcomp_refTt2{scalar_i2:i32,scalar_t1:!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>}>>) -> !fir.ref<!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>
+! CHECK:  %[[VAL_3:.*]] = hlfir.designate %[[VAL_2]]{"scalar_x"}   : (!fir.ref<!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>) -> !fir.ref<f32>
+end subroutine
+
+subroutine test_array_scalar_chain(a)
+  use comp_ref
+  type(t2) :: a(100)
+  print *, a%scalar_t1%scalar_x
+! CHECK-LABEL: func.func @_QPtest_array_scalar_chain(
+! CHECK:  %[[VAL_1:.*]] = arith.constant 100 : index
+! CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]])  {{.*}}Ea
+! CHECK:  %[[VAL_9:.*]] = hlfir.designate %[[VAL_3]]#0{"scalar_t1"}   shape %[[VAL_2]] : (!fir.ref<!fir.array<100x!fir.type<_QMcomp_refTt2{scalar_i2:i32,scalar_t1:!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>}>>>, !fir.shape<1>) -> !fir.box<!fir.array<100x!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>>
+! CHECK:  %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]]{"scalar_x"}   shape %[[VAL_2]] : (!fir.box<!fir.array<100x!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<100xf32>>
+end subroutine
+
+subroutine test_scalar_chain_2(a)
+  use comp_ref
+  type(t1) :: a(50)
+  print *, a(10)%scalar_x
+! CHECK-LABEL: func.func @_QPtest_scalar_chain_2(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]])  {{.*}}Ea
+! CHECK:  %[[VAL_9:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_10:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_9]])  : (!fir.ref<!fir.array<50x!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>>, index) -> !fir.ref<!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>
+! CHECK:  %[[VAL_11:.*]] = hlfir.designate %[[VAL_10]]{"scalar_x"}   : (!fir.ref<!fir.type<_QMcomp_refTt1{scalar_i:i32,scalar_x:f32}>>) -> !fir.ref<f32>
+end subroutine
+
+subroutine test_array_ref_chain(a)
+  use comp_ref
+  type(t_array) :: a(100)
+  print *, a(1:50:5)%array_comp(4,5)
+! CHECK-LABEL: func.func @_QPtest_array_ref_chain(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]])  {{.*}}Ea
+! CHECK:  %[[VAL_9:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_10:.*]] = arith.constant 50 : index
+! CHECK:  %[[VAL_11:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_12:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_9]]:%[[VAL_10]]:%[[VAL_11]])  shape %[[VAL_13]] : (!fir.ref<!fir.array<100x!fir.type<_QMcomp_refTt_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<10x!fir.type<_QMcomp_refTt_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>
+! CHECK:  %[[VAL_15:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_16:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_17:.*]] = fir.shape %[[VAL_15]], %[[VAL_16]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_18:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_19:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_20:.*]] = hlfir.designate %[[VAL_14]]{"array_comp"} <%[[VAL_17]]> (%[[VAL_18]], %[[VAL_19]])  shape %[[VAL_13]] : (!fir.box<!fir.array<10x!fir.type<_QMcomp_refTt_array{scalar_i:i32,array_comp:!fir.array<10x20xf32>}>>>, !fir.shape<2>, index, index, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>
+end subroutine