diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 0bd43732b9beb..78b92c4669f70 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -100,6 +100,16 @@ template std::optional IsContiguous(const A &, FoldingContext &); extern template std::optional IsContiguous( const Expr &, FoldingContext &); +extern template std::optional IsContiguous( + const ArrayRef &, FoldingContext &); +extern template std::optional IsContiguous( + const Substring &, FoldingContext &); +extern template std::optional IsContiguous( + const Component &, FoldingContext &); +extern template std::optional IsContiguous( + const ComplexPart &, FoldingContext &); +extern template std::optional IsContiguous( + const CoarrayRef &, FoldingContext &); template bool IsSimplyContiguous(const A &x, FoldingContext &context) { return IsContiguous(x, context).value_or(false); diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h index e2886f6058ace..16d0c3147bbb1 100644 --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -224,6 +224,10 @@ hlfir::Entity getElementAt(mlir::Location loc, fir::FirOpBuilder &builder, /// Compute the lower and upper bounds of an entity. llvm::SmallVector> 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> +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, diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 5e43254a94eb4..f0d79c90dd33e 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -852,6 +852,12 @@ std::optional IsContiguous(const A &x, FoldingContext &context) { template std::optional IsContiguous( const Expr &, FoldingContext &); +template std::optional IsContiguous(const ArrayRef &, FoldingContext &); +template std::optional IsContiguous(const Substring &, FoldingContext &); +template std::optional IsContiguous(const Component &, FoldingContext &); +template std::optional IsContiguous( + const ComplexPart &, FoldingContext &); +template std::optional IsContiguous(const CoarrayRef &, FoldingContext &); // IsErrorExpr() struct IsErrorExprHelper : public AnyTraverse { diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index 034ee2a992d73..df1253f636b39 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -82,38 +82,64 @@ class HlfirDesignatorBuilder { /// 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 typeParams; llvm::SmallVector 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) and the front-end + // node for the designator, compute the memory type (fir.class, fir.ref, or + // fir.box)... + template + 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(); if (charType && charType.hasDynamicLen()) - resultType = - fir::BoxCharType::get(charType.getContext(), charType.getFKind()); - else if (resultValueType.isa() || - 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() && + !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 + static bool isPolymorphic(const T &designatorNode) { + if constexpr (!std::is_same_v) { + return Fortran::semantics::IsPolymorphic(designatorNode.GetLastSymbol()); + } + return false; + } + + template + /// 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 complexPart; auto designate = getBuilder().create( - 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( @@ -128,31 +154,35 @@ class HlfirDesignatorBuilder { 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( @@ -189,34 +219,27 @@ class HlfirDesignatorBuilder { partInfo.typeParams[0] = fir::factory::genMaxWithZero(builder, loc, rawLen); } - mlir::Type resultType = changeLengthInCharacterType( - loc, baseStringType, + auto kind = hlfir::getFortranElementType(baseStringType) + .cast() + .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(type) - .Case([&](fir::CharacterType charTy) -> mlir::Type { - return fir::CharacterType::get(charTy.getContext(), charTy.getFKind(), - newLen); - }) .Case([&](fir::SequenceType seqTy) -> mlir::Type { - return fir::SequenceType::get( - seqTy.getShape(), - changeLengthInCharacterType(loc, seqTy.getEleTy(), newLen)); + return fir::SequenceType::get(seqTy.getShape(), newEleTy); }) .Case([&](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, @@ -257,16 +280,27 @@ class HlfirDesignatorBuilder { PartInfo &partInfo) { mlir::Type baseType; if (const auto *component = arrayRef.base().UnwrapComponent()) - baseType = visit(*component, partInfo); - baseType = visit(arrayRef.base().GetLastSymbol(), 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> bounds; - auto getBounds = [&](unsigned i) { - if (bounds.empty()) - bounds = hlfir::genBounds(loc, builder, partInfo.base); + 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 = @@ -280,11 +314,11 @@ class HlfirDesignatorBuilder { 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()); @@ -320,15 +354,152 @@ class HlfirDesignatorBuilder { "inconsistent hlfir.designate shape"); mlir::Type resultType = baseType.cast().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()) + 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() || + partInfo.resultShape.getType().isa()); + } + + 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 extents; + auto seqTy = hlfir::getFortranElementOrSequenceType(fieldType) + .cast(); + for (auto extent : seqTy.getShape()) + extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); + if (!hasNonDefaultLowerBounds(componentSym)) + return builder.create(loc, extents); + + llvm::SmallVector lbounds; + if (const auto *objDetails = + componentSym.detailsIf()) + 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 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 + 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(); + 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()) { + 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 diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index a3068b3ddf522..8c362a3fee184 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -316,7 +316,8 @@ struct TypeBuilderImpl { 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)) diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp index fb018c740590a..755e8d898b978 100644 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -20,47 +20,53 @@ // 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 -getExplicitExtents(fir::FortranVariableOpInterface var) { +static llvm::SmallVector getExplicitExtents(mlir::Value shape) { llvm::SmallVector result; - if (mlir::Value shape = var.getShape()) { - auto *shapeOp = shape.getDefiningOp(); - if (auto s = mlir::dyn_cast_or_null(shapeOp)) { - auto e = s.getExtents(); - result.append(e.begin(), e.end()); - } else if (auto s = mlir::dyn_cast_or_null(shapeOp)) { - auto e = s.getExtents(); - result.append(e.begin(), e.end()); - } else if (mlir::dyn_cast_or_null(shapeOp)) { - return {}; - } else { - TODO(var->getLoc(), "read fir.shape to get extents"); - } + auto *shapeOp = shape.getDefiningOp(); + if (auto s = mlir::dyn_cast_or_null(shapeOp)) { + auto e = s.getExtents(); + result.append(e.begin(), e.end()); + } else if (auto s = mlir::dyn_cast_or_null(shapeOp)) { + auto e = s.getExtents(); + result.append(e.begin(), e.end()); + } else if (mlir::dyn_cast_or_null(shapeOp)) { + return {}; + } else { + TODO(shape.getLoc(), "read fir.shape to get extents"); } return result; } +static llvm::SmallVector +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 -getExplicitLbounds(fir::FortranVariableOpInterface var) { +static llvm::SmallVector getExplicitLbounds(mlir::Value shape) { llvm::SmallVector result; - if (mlir::Value shape = var.getShape()) { - auto *shapeOp = shape.getDefiningOp(); - if (auto s = mlir::dyn_cast_or_null(shapeOp)) { - return {}; - } else if (auto s = mlir::dyn_cast_or_null(shapeOp)) { - auto e = s.getOrigins(); - result.append(e.begin(), e.end()); - } else if (auto s = mlir::dyn_cast_or_null(shapeOp)) { - auto e = s.getOrigins(); - result.append(e.begin(), e.end()); - } else { - TODO(var->getLoc(), "read fir.shape to get lower bounds"); - } + auto *shapeOp = shape.getDefiningOp(); + if (auto s = mlir::dyn_cast_or_null(shapeOp)) { + return {}; + } else if (auto s = mlir::dyn_cast_or_null(shapeOp)) { + auto e = s.getOrigins(); + result.append(e.begin(), e.end()); + } else if (auto s = mlir::dyn_cast_or_null(shapeOp)) { + auto e = s.getOrigins(); + result.append(e.begin(), e.end()); + } else { + TODO(shape.getLoc(), "read fir.shape to get lower bounds"); } return result; } +static llvm::SmallVector +getExplicitLbounds(fir::FortranVariableOpInterface var) { + if (mlir::Value shape = var.getShape()) + return getExplicitLbounds(shape); + return {}; +} static llvm::SmallVector getExplicitTypeParams(fir::FortranVariableOpInterface var) { @@ -336,6 +342,28 @@ hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder, return result; } +llvm::SmallVector> +hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value shape) { + assert((shape.getType().isa() || + shape.getType().isa()) && + "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> 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()) { diff --git a/flang/test/Lower/HLFIR/designators-component-ref.f90 b/flang/test/Lower/HLFIR/designators-component-ref.f90 new file mode 100644 index 0000000000000..5c10d445b3990 --- /dev/null +++ b/flang/test/Lower/HLFIR/designators-component-ref.f90 @@ -0,0 +1,332 @@ +! 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.ref +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}>>, index) -> !fir.ref> +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}>>, index, index, index) -> !fir.ref> +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.shape<2>) -> !fir.ref> +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.shape<2>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref> +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.shape<2>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.box> +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.shapeshift<2>) -> !fir.box> +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.shapeshift<2>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref> +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.shape<2>, index) -> !fir.ref>> +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.shape<2>, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref>> +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.shape<2>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.box>> +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>>, 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.shape<1>) -> !fir.box> +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.shape<1>, index) -> !fir.box>> +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}>>>, index, index, !fir.shape<1>, index) -> !fir.box>> +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.shape<2>, index, index, !fir.shape<1>) -> !fir.box> +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.ref> +! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_2]]{"scalar_x"} : (!fir.ref>) -> !fir.ref +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.shape<1>) -> !fir.box>> +! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]]{"scalar_x"} shape %[[VAL_2]] : (!fir.box>>, !fir.shape<1>) -> !fir.box> +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>>, index) -> !fir.ref> +! CHECK: %[[VAL_11:.*]] = hlfir.designate %[[VAL_10]]{"scalar_x"} : (!fir.ref>) -> !fir.ref +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}>>>, index, index, index, !fir.shape<1>) -> !fir.box}>>> +! 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.shape<2>, index, index, !fir.shape<1>) -> !fir.box> +end subroutine