[flang] Fix problems with constant arrays with lower bounds that are not 1
There were two problems with constant arrays whose lower bound is not 1.
First, when folding the arrays, we were creating the folded array to have lower
bounds of 1 but, we were not re-adjusting their lower bounds to the
declared values. Second, we were not calculating the extents correctly.
Both of these problems led to bogus error messages.
I fixed the first problem by adjusting the lower bounds in
NonPointerInitializationExpr() in Evaluate/check-expression.cpp. I wrote the
class ArrayConstantBoundChanger, which is similar to the existing class
ScalarConstantExpander. In the process of implementing and testing it, I found
a bug that I fixed in ScalarConstantExpander which caused it to infinitely
recurse on parenthesized expressions. I also removed the unrelated class
ScalarExpansionVisitor, which was not used.
I fixed the second problem by changing the formula that calculates upper bounds
in in the function ComputeUpperBound() in Evaluate/shape.cpp.
I added tests that trigger the bogus error messages mentioned above along with
a constant folding tests that uses array operands with shapes that conform but
have different bounds.
In the process of adding tests, I discovered that tests in
Evaluate/folding09.f90 and folding16.f90 were written incorrectly, and I
fixed them. This also revealed a bug in contant folding of the
intrinsic "lbounds" which I plan to fix in a later change.
Differential Revision: https://reviews.llvm.org/D95449
GitOrigin-RevId: 543cd89d3fb5a108d4050635c00093695b2b6c6d
diff --git a/include/flang/Evaluate/tools.h b/include/flang/Evaluate/tools.h
index 351dc87..3210ab5 100644
--- a/include/flang/Evaluate/tools.h
+++ b/include/flang/Evaluate/tools.h
@@ -895,8 +895,8 @@
}
return expanded;
}
- template <typename T> Constant<T> Expand(Parentheses<T> &&x) {
- return Expand(std::move(x)); // Constant<> can be parenthesized
+ template <typename T> Expr<T> Expand(Parentheses<T> &&x) {
+ return Expand(std::move(x.left())); // 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))}; },
diff --git a/lib/Evaluate/check-expression.cpp b/lib/Evaluate/check-expression.cpp
index 4bedbe8..2e061f0 100644
--- a/lib/Evaluate/check-expression.cpp
+++ b/lib/Evaluate/check-expression.cpp
@@ -305,26 +305,30 @@
}
}
-class ScalarExpansionVisitor : public AnyTraverse<ScalarExpansionVisitor,
- std::optional<Expr<SomeType>>> {
+class ArrayConstantBoundChanger {
public:
- using Result = std::optional<Expr<SomeType>>;
- using Base = AnyTraverse<ScalarExpansionVisitor, Result>;
- ScalarExpansionVisitor(
- ConstantSubscripts &&shape, std::optional<ConstantSubscripts> &&lb)
- : Base{*this}, shape_{std::move(shape)}, lbounds_{std::move(lb)} {}
- using Base::operator();
- template <typename T> Result operator()(const Constant<T> &x) {
- auto expanded{x.Reshape(std::move(shape_))};
- if (lbounds_) {
- expanded.set_lbounds(std::move(*lbounds_));
- }
- return AsGenericExpr(std::move(expanded));
+ ArrayConstantBoundChanger(ConstantSubscripts &&lbounds)
+ : lbounds_{std::move(lbounds)} {}
+
+ template <typename A> A ChangeLbounds(A &&x) const {
+ return std::move(x); // default case
+ }
+ template <typename T> Constant<T> ChangeLbounds(Constant<T> &&x) {
+ x.set_lbounds(std::move(lbounds_));
+ return std::move(x);
+ }
+ template <typename T> Expr<T> ChangeLbounds(Parentheses<T> &&x) {
+ return ChangeLbounds(
+ std::move(x.left())); // Constant<> can be parenthesized
+ }
+ template <typename T> Expr<T> ChangeLbounds(Expr<T> &&x) {
+ return std::visit(
+ [&](auto &&x) { return Expr<T>{ChangeLbounds(std::move(x))}; },
+ std::move(x.u)); // recurse until we hit a constant
}
private:
- ConstantSubscripts shape_;
- std::optional<ConstantSubscripts> lbounds_;
+ ConstantSubscripts &&lbounds_;
};
// Converts, folds, and then checks type, rank, and shape of an
@@ -351,7 +355,11 @@
symbol.name(), symRank, folded.Rank());
}
} else if (auto extents{AsConstantExtents(context, symTS->shape())}) {
- if (folded.Rank() == 0 && symRank > 0) {
+ 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 ScalarConstantExpander{std::move(*extents),
AsConstantExtents(
context, GetLowerBounds(context, NamedEntity{symbol}))}
@@ -360,7 +368,11 @@
if (CheckConformance(context.messages(), symTS->shape(),
*resultShape, "initialized object",
"initialization expression", false, false)) {
- return {std::move(folded)};
+ // make a constant array with adjusted lower bounds
+ return ArrayConstantBoundChanger{
+ std::move(*AsConstantExtents(
+ context, GetLowerBounds(context, NamedEntity{symbol})))}
+ .ChangeLbounds(std::move(folded));
}
}
} else if (IsNamedConstant(symbol)) {
diff --git a/lib/Evaluate/shape.cpp b/lib/Evaluate/shape.cpp
index eb94139..6dc2edd 100644
--- a/lib/Evaluate/shape.cpp
+++ b/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/test/Evaluate/folding09.f90 b/test/Evaluate/folding09.f90
index 6efd3c0..ed60f08 100644
--- a/test/Evaluate/folding09.f90
+++ b/test/Evaluate/folding09.f90
@@ -13,16 +13,16 @@
real, intent(in) :: arr1(:), arr2(10), mat(10, 10)
real, intent(in), contiguous :: arr3(:)
real :: scalar
- logical, parameter :: isc01 = is_contiguous(0)
- logical, parameter :: isc02 = is_contiguous(scalar)
- logical, parameter :: isc03 = is_contiguous(scalar + scalar)
- logical, parameter :: isc04 = is_contiguous([0, 1, 2])
- logical, parameter :: isc05 = is_contiguous(arr1 + 1.0)
- logical, parameter :: isc06 = is_contiguous(arr2)
- logical, parameter :: isc07 = is_contiguous(mat)
- logical, parameter :: isc08 = is_contiguous(mat(1:10,1))
- logical, parameter :: isc09 = is_contiguous(arr2(1:10:1))
- logical, parameter :: isc10 = is_contiguous(arr3)
- logical, parameter :: isc11 = is_contiguous(f())
+ logical, parameter :: test_isc01 = is_contiguous(0)
+ logical, parameter :: test_isc02 = is_contiguous(scalar)
+ logical, parameter :: test_isc03 = is_contiguous(scalar + scalar)
+ logical, parameter :: test_isc04 = is_contiguous([0, 1, 2])
+ logical, parameter :: test_isc05 = is_contiguous(arr1 + 1.0)
+ logical, parameter :: test_isc06 = is_contiguous(arr2)
+ logical, parameter :: test_isc07 = is_contiguous(mat)
+ logical, parameter :: test_isc08 = is_contiguous(mat(1:10,1))
+ logical, parameter :: test_isc09 = is_contiguous(arr2(1:10:1))
+ logical, parameter :: test_isc10 = is_contiguous(arr3)
+ logical, parameter :: test_isc11 = is_contiguous(f())
end subroutine
end module
diff --git a/test/Evaluate/folding16.f90 b/test/Evaluate/folding16.f90
index 0918381..a21f5a7 100644
--- a/test/Evaluate/folding16.f90
+++ b/test/Evaluate/folding16.f90
@@ -1,8 +1,17 @@
! RUN: %S/test_folding.sh %s %t %f18
! Ensure that lower bounds are accounted for in intrinsic folding;
! 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)
-logical, parameter :: test = lbound(a,1)==-1 .and. lbound(b,1)==-1 .and. &
- lbound(log(a),1)==1 .and. all(b==0)
+module m
+ 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]
+ integer, parameter :: e(-2:0) = ([33, 22, 11])
+ ! The following test is commented out because constant folding for "lbound"
+ ! is currently broken
+ !logical, parameter :: test_1 = lbound(a,1)==-1 .and. lbound(b,1)==-1 .and. &
+ ! lbound(log(a),1)==1 .and. all(b==0)
+ logical, parameter :: test_2 = all(c .eq. d)
+ logical, parameter :: test_3 = all(c .eq. e)
+ logical, parameter :: test_4 = all(d .eq. e)
end
diff --git a/test/Evaluate/test_folding.sh b/test/Evaluate/test_folding.sh
index 20f7d16..81ecbea 100755
--- a/test/Evaluate/test_folding.sh
+++ b/test/Evaluate/test_folding.sh
@@ -5,8 +5,8 @@
# To check folding of an expression EXPR, the fortran program passed to this script
# must contain the following:
# logical, parameter :: test_x = <compare EXPR to expected value>
-# This script will test that all parameter with a name starting with "test_" have
-# been folded to .true.
+# This script will test that all parameter with a name starting with "test_"
+# have been folded to .true.
# For instance, acos folding can be tested with:
#
# real(4), parameter :: res_acos = acos(0.5_4)
diff --git a/test/Semantics/array-constr-values.f90 b/test/Semantics/array-constr-values.f90
index b0b21fb..ddab8a6 100644
--- a/test/Semantics/array-constr-values.f90
+++ b/test/Semantics/array-constr-values.f90
@@ -54,12 +54,28 @@
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/)
+ integer, parameter, dimension(-1:0) :: negLower1 = ((/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
+ call inner(negLower1(:)) ! OK
+
+ contains
+ subroutine inner(arg)
+ integer :: arg(:)
+ end subroutine inner
end subroutine checkC7115
subroutine checkOkDuplicates
real :: realArray(21) = &
