[flang-commits] [flang] ffc3051 - [flang] Lower component-ref to hlfir.designate
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Thu Jan 12 01:13:17 PST 2023
Author: Jean Perier
Date: 2023-01-12T10:12:54+01:00
New Revision: ffc3051d0fb7ef32e0af86571251d1f35eb191bd
URL: https://github.com/llvm/llvm-project/commit/ffc3051d0fb7ef32e0af86571251d1f35eb191bd
DIFF: https://github.com/llvm/llvm-project/commit/ffc3051d0fb7ef32e0af86571251d1f35eb191bd.diff
LOG: [flang] Lower component-ref to hlfir.designate
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).
Differential Revision: https://reviews.llvm.org/D141470
Added:
flang/test/Lower/HLFIR/designators-component-ref.f90
Modified:
flang/include/flang/Evaluate/check-expression.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
Removed:
################################################################################
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 <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);
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<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,
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<bool> IsContiguous(const A &x, FoldingContext &context) {
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> {
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<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>(
@@ -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<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,
@@ -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<std::pair<mlir::Value, mlir::Value>> 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<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
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<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");
- }
+ 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(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");
- }
+ 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(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) {
@@ -336,6 +342,28 @@ hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
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>()) {
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.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
More information about the flang-commits
mailing list