diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -873,33 +873,34 @@
const std::optional<characteristics::Procedure> &lhsProcedure,
const characteristics::Procedure *rhsProcedure);
-// Scalar constant expansion
-class ScalarConstantExpander {
+// Constant array creation. It creates a constant array by expanding a
+// constant or by changing the lower bounds of an existing array
+class ArrayConstantMaker {
public:
- explicit ScalarConstantExpander(ConstantSubscripts &&extents)
+ explicit ArrayConstantMaker(ConstantSubscripts &&extents)
: extents_{std::move(extents)} {}
- ScalarConstantExpander(
+ ArrayConstantMaker(
ConstantSubscripts &&extents, std::optional<ConstantSubscripts> &&lbounds)
: extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
- ScalarConstantExpander(
- ConstantSubscripts &&extents, ConstantSubscripts &&lbounds)
+ ArrayConstantMaker(ConstantSubscripts &&extents, ConstantSubscripts &&lbounds)
: extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
- template <typename A> A Expand(A &&x) const {
+ template <typename A> A MakeArray(A &&x) const {
return std::move(x); // default case
}
- template <typename T> Constant<T> Expand(Constant<T> &&x) {
- auto expanded{x.Reshape(std::move(extents_))};
+ template <typename T> Constant<T> MakeArray(Constant<T> &&x) {
+ auto array{x.Reshape(std::move(extents_))};
if (lbounds_) {
- expanded.set_lbounds(std::move(*lbounds_));
+ array.set_lbounds(std::move(*lbounds_));
}
- return expanded;
+ return array;
}
- template <typename T> Constant<T> Expand(Parentheses<T> &&x) {
- return Expand(std::move(x)); // Constant<> can be parenthesized
+ template <typename T> Constant<T> MakeArray(Parentheses<T> &&x) {
+ return MakeArray(std::move(x)); // Constant<> can be parenthesized
}
- template <typename T> Expr<T> Expand(Expr<T> &&x) {
- return std::visit([&](auto &&x) { return Expr<T>{Expand(std::move(x))}; },
+ template <typename T> Expr<T> MakeArray(Expr<T> &&x) {
+ return std::visit(
+ [&](auto &&x) { return Expr<T>{MakeArray(std::move(x))}; },
std::move(x.u));
}
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -351,16 +351,24 @@
symbol.name(), symRank, folded.Rank());
}
} else if (auto extents{AsConstantExtents(context, symTS->shape())}) {
- if (folded.Rank() == 0 && symRank > 0) {
- return ScalarConstantExpander{std::move(*extents),
+ if (folded.Rank() == 0 && symRank == 0) {
+ // symbol and constant are both scalars
+ return {std::move(folded)};
+ } else if (folded.Rank() == 0 && symRank > 0) {
+ // expand the scalar constant to an array
+ return ArrayConstantMaker{std::move(*extents),
AsConstantExtents(
context, GetLowerBounds(context, NamedEntity{symbol}))}
- .Expand(std::move(folded));
+ .MakeArray(std::move(folded));
} else if (auto resultShape{GetShape(context, folded)}) {
if (CheckConformance(context.messages(), symTS->shape(),
*resultShape, "initialized object",
"initialization expression", false, false)) {
- return {std::move(folded)};
+ // make an array with adjusted lower bounds
+ return ArrayConstantMaker{std::move(*extents),
+ AsConstantExtents(
+ context, GetLowerBounds(context, NamedEntity{symbol}))}
+ .MakeArray(std::move(folded));
}
}
} else if (IsNamedConstant(symbol)) {
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -73,7 +73,7 @@
if (auto valueShape{GetConstantExtents(context, expr)}) {
if (auto componentShape{GetConstantExtents(context, symbol)}) {
if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {
- expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(
+ expr = ArrayConstantMaker{std::move(*componentShape)}.MakeArray(
std::move(expr));
ok = expr.Rank() > 0;
} else {
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -373,7 +373,7 @@
MaybeExtentExpr ComputeUpperBound(
ExtentExpr &&lower, MaybeExtentExpr &&extent) {
if (extent) {
- return std::move(*extent) - std::move(lower) + ExtentExpr{1};
+ return std::move(*extent) + std::move(lower) - ExtentExpr{1};
} else {
return std::nullopt;
}
diff --git a/flang/test/Evaluate/folding16.f90 b/flang/test/Evaluate/folding16.f90
--- a/flang/test/Evaluate/folding16.f90
+++ b/flang/test/Evaluate/folding16.f90
@@ -3,6 +3,9 @@
! this is a regression test for a bug in which they were not
real, parameter :: a(-1:-1) = 1.
real, parameter :: b(-1:-1) = log(a)
+integer, parameter :: c(-1:1) = [33, 22, 11]
+integer, parameter :: d(1:3) = [33, 22, 11]
logical, parameter :: test = lbound(a,1)==-1 .and. lbound(b,1)==-1 .and. &
lbound(log(a),1)==1 .and. all(b==0)
+logical, parameter :: test2 = all(c .eq. d)
end
diff --git a/flang/test/Semantics/array-constr-values.f90 b/flang/test/Semantics/array-constr-values.f90
--- a/flang/test/Semantics/array-constr-values.f90
+++ b/flang/test/Semantics/array-constr-values.f90
@@ -54,12 +54,26 @@
subroutine checkC7115()
real, dimension(10), parameter :: good1 = [(99.9, i = 1, 10)]
real, dimension(100), parameter :: good2 = [((88.8, i = 1, 10), j = 1, 10)]
+ real, dimension(-1:0), parameter :: good3 = [77.7, 66.6]
!ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
!ERROR: Value of named constant 'bad2' ([INTEGER(4)::(int(j,kind=4),INTEGER(8)::j=1_8,1_8,0_8)]) cannot be computed as a constant value
!ERROR: The stride of an implied DO loop must not be zero
integer, parameter :: bad2(*) = [(j, j=1,1,0)]
+ integer, parameter, dimension(-1:0) :: negLower = (/343,512/)
+
+ real :: local
+
+ local = good3(0)
+ !ERROR: Subscript value (2) is out of range on dimension 1 in reference to a constant array value
+ local = good3(2)
+ call inner(negLower(:)) ! OK
+
+ contains
+ subroutine inner(arg)
+ integer :: arg(:)
+ end subroutine inner
end subroutine checkC7115
subroutine checkOkDuplicates
real :: realArray(21) = &