[flang-commits] [flang] 16c4b32 - [flang] Correct handling of non-default lower bounds in ASSOCIATE with named constants
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 1 09:54:36 PDT 2023
Author: Peter Klausler
Date: 2023-08-01T09:54:31-07:00
New Revision: 16c4b320fe9544f9556c0d1d733f5c50f1ba0da3
URL: https://github.com/llvm/llvm-project/commit/16c4b320fe9544f9556c0d1d733f5c50f1ba0da3
DIFF: https://github.com/llvm/llvm-project/commit/16c4b320fe9544f9556c0d1d733f5c50f1ba0da3.diff
LOG: [flang] Correct handling of non-default lower bounds in ASSOCIATE with named constants
Work through several issues with LBOUND() and UBOUND() of ASSOCIATE
construct entities that have been associated with named constants or
subobjects of named constants that are sporting non-default lower bounds.
Sometimes the non-default lower bounds matter, sometimes they don't.
Add a fairly exhaustive test to work through the possibilities.
Differential Revision: https://reviews.llvm.org/D156756
Added:
flang/test/Semantics/associate02.f90
Modified:
flang/include/flang/Evaluate/constant.h
flang/lib/Evaluate/constant.cpp
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/formatting.cpp
flang/lib/Evaluate/shape.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Lower/HLFIR/constant.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h
index 73e4271cc28adf..04474e2f49a0f8 100644
--- a/flang/include/flang/Evaluate/constant.h
+++ b/flang/include/flang/Evaluate/constant.h
@@ -63,12 +63,23 @@ class ConstantBounds {
explicit ConstantBounds(ConstantSubscripts &&shape);
~ConstantBounds();
const ConstantSubscripts &shape() const { return shape_; }
+ int Rank() const { return GetRank(shape_); }
+ Constant<SubscriptInteger> SHAPE() const;
+
+ // It is possible in this representation for a constant array to have
+ // lower bounds other than 1, which is of course not expressible in
+ // Fortran. This case arises only from definitions of named constant
+ // arrays with such bounds, as in:
+ // REAL, PARAMETER :: NAMED(0:1) = [1.,2.]
+ // Bundling the lower bounds of the named constant with its
+ // constant value allows folding of subscripted array element
+ // references, LBOUND, and UBOUND without having to thread the named
+ // constant or its bounds throughout folding.
const ConstantSubscripts &lbounds() const { return lbounds_; }
ConstantSubscripts ComputeUbounds(std::optional<int> dim) const;
void set_lbounds(ConstantSubscripts &&);
void SetLowerBoundsToOne();
- int Rank() const { return GetRank(shape_); }
- Constant<SubscriptInteger> SHAPE() const;
+ bool HasNonDefaultLowerBound() const;
// If no optional dimension order argument is passed, increments a vector of
// subscripts in Fortran array order (first dimension varying most quickly).
diff --git a/flang/lib/Evaluate/constant.cpp b/flang/lib/Evaluate/constant.cpp
index c94b198fdaf2e1..084836b4ec3677 100644
--- a/flang/lib/Evaluate/constant.cpp
+++ b/flang/lib/Evaluate/constant.cpp
@@ -56,6 +56,15 @@ Constant<SubscriptInteger> ConstantBounds::SHAPE() const {
return AsConstantShape(shape_);
}
+bool ConstantBounds::HasNonDefaultLowerBound() const {
+ for (auto n : lbounds_) {
+ if (n != 1) {
+ return true;
+ }
+ }
+ return false;
+}
+
ConstantSubscript ConstantBounds::SubscriptsToOffset(
const ConstantSubscripts &index) const {
CHECK(GetRank(index) == GetRank(shape_));
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 50e9b3bc22cfa0..544a0b67a49598 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -255,11 +255,11 @@ std::optional<Constant<T>> Folder<T>::ApplyComponent(
const std::vector<Constant<SubscriptInteger>> *subscripts) {
if (auto scalar{structures.GetScalarValue()}) {
if (std::optional<Expr<SomeType>> expr{scalar->Find(component)}) {
- if (const Constant<T> *value{UnwrapConstantValue<T>(expr.value())}) {
- if (!subscripts) {
- return std::move(*value);
- } else {
+ if (const Constant<T> *value{UnwrapConstantValue<T>(*expr)}) {
+ if (subscripts) {
return ApplySubscripts(*value, *subscripts);
+ } else {
+ return *value;
}
}
}
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index f70d722c8b2c49..7e3d0596549450 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -126,7 +126,7 @@ class GetConstantArrayBoundHelper {
}
template <typename T> ConstantSubscripts Get(const Parentheses<T> &x) {
- // Cause of temp variable inside parentheses - return [1, ... 1] for lower
+ // Case of temp variable inside parentheses - return [1, ... 1] for lower
// bounds and shape for upper bounds
if (getLbound_) {
return ConstantSubscripts(x.Rank(), ConstantSubscript{1});
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 84dd4be76cd9c9..098cd7c9d8119b 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -19,23 +19,35 @@
namespace Fortran::evaluate {
-static void ShapeAsFortran(
- llvm::raw_ostream &o, const ConstantSubscripts &shape) {
- if (GetRank(shape) > 1) {
+static void ShapeAsFortran(llvm::raw_ostream &o,
+ const ConstantSubscripts &shape, const ConstantSubscripts &lbounds,
+ bool hasNonDefaultLowerBound) {
+ if (GetRank(shape) > 1 || hasNonDefaultLowerBound) {
o << ",shape=";
char ch{'['};
for (auto dim : shape) {
o << ch << dim;
ch = ',';
}
- o << "])";
+ o << ']';
+ if (hasNonDefaultLowerBound) {
+ o << ",%lbound=";
+ ch = '[';
+ for (auto lb : lbounds) {
+ o << ch << lb;
+ ch = ',';
+ }
+ o << ']';
+ }
+ o << ')';
}
}
template <typename RESULT, typename VALUE>
llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
llvm::raw_ostream &o) const {
- if (Rank() > 1) {
+ bool hasNonDefaultLowerBound{HasNonDefaultLowerBound()};
+ if (Rank() > 1 || hasNonDefaultLowerBound) {
o << "reshape(";
}
if (Rank() > 0) {
@@ -71,14 +83,15 @@ llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
if (Rank() > 0) {
o << ']';
}
- ShapeAsFortran(o, shape());
+ ShapeAsFortran(o, shape(), lbounds(), hasNonDefaultLowerBound);
return o;
}
template <int KIND>
llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
llvm::raw_ostream &o) const {
- if (Rank() > 1) {
+ bool hasNonDefaultLowerBound{HasNonDefaultLowerBound()};
+ if (Rank() > 1 || hasNonDefaultLowerBound) {
o << "reshape(";
}
if (Rank() > 0) {
@@ -98,7 +111,7 @@ llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
if (Rank() > 0) {
o << ']';
}
- ShapeAsFortran(o, shape());
+ ShapeAsFortran(o, shape(), lbounds(), hasNonDefaultLowerBound);
return o;
}
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 652b59d901d6df..c86498fa413f43 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -314,7 +314,7 @@ class GetLowerBoundHelper
DescriptorInquiry::Field::LowerBound, dimension_}};
}
} else {
- auto exprLowerBound{((*this)(assoc->expr()))};
+ Result exprLowerBound{((*this)(assoc->expr()))};
if (IsActuallyConstant(exprLowerBound)) {
return std::move(exprLowerBound);
} else {
@@ -334,8 +334,8 @@ class GetLowerBoundHelper
}
}
- Result operator()(const Symbol &symbol0) const {
- return GetLowerBound(symbol0, NamedEntity{symbol0});
+ Result operator()(const Symbol &symbol) const {
+ return GetLowerBound(symbol, NamedEntity{symbol});
}
Result operator()(const Component &component) const {
@@ -346,8 +346,30 @@ class GetLowerBoundHelper
return Result{1};
}
+ template <typename T> Result operator()(const Expr<T> &expr) const {
+ if (const Symbol * whole{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
+ return (*this)(*whole);
+ } else if constexpr (common::HasMember<Constant<T>, decltype(expr.u)>) {
+ if (const auto *con{std::get_if<Constant<T>>(&expr.u)}) {
+ ConstantSubscripts lb{con->lbounds()};
+ if (dimension_ < GetRank(lb)) {
+ return Result{lb[dimension_]};
+ }
+ } else { // operation
+ return Result{1};
+ }
+ } else {
+ return (*this)(expr.u);
+ }
+ if constexpr (LBOUND_SEMANTICS) {
+ return Result{};
+ } else {
+ return Result{1};
+ }
+ }
+
private:
- int dimension_;
+ int dimension_; // zero-based
FoldingContext *context_{nullptr};
};
@@ -618,16 +640,27 @@ static MaybeExtentExpr GetUBOUND(
if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) {
return *ubound;
} else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
- return std::nullopt;
+ return std::nullopt; // UBOUND() folding replaces with -1
} else if (auto lb{GetLBOUND(base, dimension)}) {
return ComputeUpperBound(std::move(*lb), GetExtent(base, dimension));
}
}
} else if (const auto *assoc{
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
- if (auto extent{GetAssociatedExtent(base, *assoc, dimension)}) {
- if (auto lb{GetLBOUND(base, dimension)}) {
- return ComputeUpperBound(std::move(*lb), std::move(extent));
+ if (assoc->rank()) { // SELECT RANK case
+ const Symbol &resolved{ResolveAssociations(symbol)};
+ if (IsDescriptor(resolved) && dimension < *assoc->rank()) {
+ ExtentExpr lb{DescriptorInquiry{NamedEntity{base},
+ DescriptorInquiry::Field::LowerBound, dimension}};
+ ExtentExpr extent{DescriptorInquiry{
+ std::move(base), DescriptorInquiry::Field::Extent, dimension}};
+ return ComputeUpperBound(std::move(lb), std::move(extent));
+ }
+ } else if (assoc->expr()) {
+ if (auto extent{GetAssociatedExtent(base, *assoc, dimension)}) {
+ if (auto lb{GetLBOUND(base, dimension)}) {
+ return ComputeUpperBound(std::move(*lb), std::move(extent));
+ }
}
}
}
@@ -644,29 +677,12 @@ MaybeExtentExpr GetUBOUND(
}
static Shape GetUBOUNDs(FoldingContext *context, const NamedEntity &base) {
- const Symbol &symbol{
- ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
- if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
- Shape result;
- int dim{0};
- for (const auto &shapeSpec : details->shape()) {
- if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) {
- result.emplace_back(*ubound);
- } else if (details->IsAssumedSize() && dim + 1 == base.Rank()) {
- result.emplace_back(std::nullopt); // UBOUND folding replaces with -1
- } else if (auto lb{GetLBOUND(base, dim)}) {
- result.emplace_back(
- ComputeUpperBound(std::move(*lb), GetExtent(base, dim)));
- } else {
- result.emplace_back(); // unknown
- }
- ++dim;
- }
- CHECK(GetRank(result) == symbol.Rank());
- return result;
- } else {
- return std::move(GetShape(symbol).value());
+ Shape result;
+ int rank{base.Rank()};
+ for (int dim{0}; dim < rank; ++dim) {
+ result.emplace_back(GetUBOUND(context, base, dim));
}
+ return result;
}
Shape GetUBOUNDs(FoldingContext &context, const NamedEntity &base) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e4b68a0d1abaf5..44377836c62a0f 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -311,9 +311,10 @@ MaybeExpr ExpressionAnalyzer::ApplySubscripts(
void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) {
// Fold subscript expressions and check for an empty triplet.
- Shape lb{GetLBOUNDs(foldingContext_, ref.base())};
+ const Symbol &arraySymbol{ref.base().GetLastSymbol()};
+ Shape lb{GetLBOUNDs(foldingContext_, NamedEntity{arraySymbol})};
CHECK(lb.size() >= ref.subscript().size());
- Shape ub{GetUBOUNDs(foldingContext_, ref.base())};
+ Shape ub{GetUBOUNDs(foldingContext_, NamedEntity{arraySymbol})};
CHECK(ub.size() >= ref.subscript().size());
bool anyPossiblyEmptyDim{false};
int dim{0};
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 853081007e85e6..22f3e419cddb86 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -8599,8 +8599,7 @@ void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
auto origDetails{origComp.get<ObjectEntityDetails>()};
if (const MaybeExpr & init{origDetails.init()}) {
SomeExpr newInit{*init};
- MaybeExpr folded{
- evaluate::Fold(foldingContext, std::move(newInit))};
+ MaybeExpr folded{FoldExpr(std::move(newInit))};
details->set_init(std::move(folded));
}
}
diff --git a/flang/test/Lower/HLFIR/constant.f90 b/flang/test/Lower/HLFIR/constant.f90
index 4a88702591c655..86f46f932a9969 100644
--- a/flang/test/Lower/HLFIR/constant.f90
+++ b/flang/test/Lower/HLFIR/constant.f90
@@ -42,11 +42,11 @@ subroutine test_constant_array_char()
subroutine test_constant_with_lower_bounds()
integer, parameter :: i(-1:0, -1:0) = reshape([1,2,3,4], shape=[2,2])
print *, i
-! CHECK: %[[VAL_12:.*]] = fir.address_of(@_QQro[[name:.*]]) : !fir.ref<!fir.array<2x2xi32>>
-! CHECK: %[[VAL_13:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_12:.*]] = fir.address_of(@_QFtest_constant_with_lower_boundsECi) : !fir.ref<!fir.array<2x2xi32>>
+! CHECK: %[[VAL_13:.*]] = arith.constant -1 : index
! CHECK: %[[VAL_14:.*]] = arith.constant 2 : index
! CHECK: %[[VAL_15:.*]] = arith.constant -1 : index
-! CHECK: %[[VAL_16:.*]] = arith.constant -1 : index
-! CHECK: %[[VAL_17:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_13]], %[[VAL_16]], %[[VAL_14]] : (index, index, index, index) -> !fir.shapeshift<2>
-! CHECK: hlfir.declare %[[VAL_12]](%[[VAL_17]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro[[name]]"} : (!fir.ref<!fir.array<2x2xi32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x2xi32>>, !fir.ref<!fir.array<2x2xi32>>)
+! CHECK: %[[VAL_16:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_17:.*]] = fir.shape_shift %[[VAL_13]], %[[VAL_14]], %[[VAL_15]], %[[VAL_16]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK: hlfir.declare %[[VAL_12]](%[[VAL_17]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtest_constant_with_lower_boundsECi"} : (!fir.ref<!fir.array<2x2xi32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x2xi32>>, !fir.ref<!fir.array<2x2xi32>>)
end subroutine
diff --git a/flang/test/Semantics/associate02.f90 b/flang/test/Semantics/associate02.f90
new file mode 100644
index 00000000000000..08896a1a07ea72
--- /dev/null
+++ b/flang/test/Semantics/associate02.f90
@@ -0,0 +1,78 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! Sometimes associations with named constants involving non-default
+! lower bounds expose those bounds to LBOUND()/UBOUND(), sometimes
+! they do not.
+subroutine s(n)
+ integer, intent(in) :: n
+ type t
+ real component(0:1,2:3)
+ end type
+ real, parameter :: abcd(2,2) = reshape([1.,2.,3.,4.], shape(abcd))
+ real, parameter :: namedConst1(-1:0,-2:-1) = abcd
+ type(t), parameter :: namedConst2 = t(abcd)
+ type(t), parameter :: namedConst3(2:3,3:4) = reshape([(namedConst2,j=1,size(namedConst3))], shape(namedConst3))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(abcd), ubound(abcd), shape(abcd)
+!CHECK: PRINT *, [INTEGER(4)::-1_4,-2_4], [INTEGER(4)::0_4,-1_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(namedConst1), ubound(namedConst1), shape(namedConst1)
+!CHECK: PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(namedConst2%component), ubound(namedConst2%component), shape(namedConst2%component)
+!CHECK: PRINT *, [INTEGER(4)::2_4,3_4], [INTEGER(4)::3_4,4_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(namedConst3), ubound(namedConst3), shape(namedConst3)
+!CHECK: PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(namedConst3(n,n)%component), ubound(namedConst3(n,n)%component), shape(namedConst3(n,n)%component)
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(namedConst3%component(0,2)), ubound(namedConst3%component(0,2)), shape(namedConst3%component(0,2))
+ associate (a => abcd)
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst1)
+!CHECK: PRINT *, [INTEGER(4)::-1_4,-2_4], [INTEGER(4)::0_4,-1_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => (namedConst1))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst1 * 2.)
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst2%component)
+!CHECK: PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => (namedConst2%component))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst2%component * 2.)
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst3)
+!CHECK: PRINT *, [INTEGER(4)::2_4,3_4], [INTEGER(4)::3_4,4_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => (namedConst3))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst3(n,n)%component)
+!CHECK: PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => (namedConst3(n,n)%component))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst3(n,n)%component * 2.)
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+ associate (a => namedConst3%component(0,2))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+ print *, lbound(a), ubound(a), shape(a)
+ end associate
+end
More information about the flang-commits
mailing list