[flang] Fix problems with constant arrays with lower bounds that are not 1

[PeteSteinfeld]

Summary

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 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 found an
existing class and method that did exactly what was needed that was originally
designed to expand a scalar value into an array called ScalarConstantExpander.
I renamed this class to reflect its generalization to ArrayConstantMaker.

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.

[klausler]

Can you fix the problem by just calling "x.set_lbounds(GetLowerBounds())" on the folded result array and leaving ScalarConstantExpander alone?

[PeteSteinfeld]

In D95449#2523153, @klausler wrote:

Can you fix the problem by just calling "x.set_lbounds(GetLowerBounds())" on the folded result array and leaving ScalarConstantExpander alone?

The expression that needs to have its lower bounds modified is of type Expr<SomeType>. But the set_lbounds() method is defined for the types Constant<T>, ConstantBase<T>, and ConstantBounds<T>. So to use set_lbounds(), I need to walk down through the layers of Expr<> objects to get to an object of type Constant<T> and then call set_lbounds() on it.

So I could create a class to do this, but that class would be very similar to the exiting class that I've renamed as ArrayConstantMaker. Potential differences would be that it might not require a method that takes Parenthese<T> as an arugment (I'm not sure about this), the call to Reshape() would not be required, and the new class would need fewer constructors.

Thus, it seems to me that it's better to use a single class to create constant arrays with new lower bounds that handles both scalars and arrays.

Let me know if my analysis is wrong, or if you agree with my analysis but not me conclusion.

[klausler]

In D95449#2524183, @PeteSteinfeld wrote:

In D95449#2523153, @klausler wrote:

Can you fix the problem by just calling "x.set_lbounds(GetLowerBounds())" on the folded result array and leaving ScalarConstantExpander alone?

The expression that needs to have its lower bounds modified is of type Expr<SomeType>. But the set_lbounds() method is defined for the types Constant<T>, ConstantBase<T>, and ConstantBounds<T>. So to use set_lbounds(), I need to walk down through the layers of Expr<> objects to get to an object of type Constant<T> and then call set_lbounds() on it.

So I could create a class to do this, but that class would be very similar to the exiting class that I've renamed as ArrayConstantMaker. Potential differences would be that it might not require a method that takes Parenthese<T> as an arugment (I'm not sure about this), the call to Reshape() would not be required, and the new class would need fewer constructors.

Thus, it seems to me that it's better to use a single class to create constant arrays with new lower bounds that handles both scalars and arrays.

Let me know if my analysis is wrong, or if you agree with my analysis but not me conclusion.

I think I'd rather have two specifically purposed facilities for scalar expansion and for setting lower bounds than one mash-up of those two. If you must combine them, make sure that there's a CHECK that ensures that the original array is either scalar or has exactly the same shape.

[PeteSteinfeld]

I implemented a separate class to handle changing the lower bounds of array
constants as suggested by Peter. In the process I noticed that there was an
unused class in Evaluate/check-expression.cpp. Also, when implementing the new
class I found a bug when handling parenthesized expressions which also exists
in the class I was previously using, so I fixed it in both places. I also
added new tests that include parenthesized expressions.

[tskeith]

flang/lib/Evaluate/check-expression.cpp

332

I think this needs to be return std::move(x);

[PeteSteinfeld]

flang/lib/Evaluate/check-expression.cpp

332

Thanks, Tim. I'll change it.

[tskeith]

flang/lib/Evaluate/check-expression.cpp

324

Since lbounds has to be a non-empty optional, why make it optional at all? I.e. why not declare it as ConstantSubscripts &&lbounds?

[PeteSteinfeld]

flang/lib/Evaluate/check-expression.cpp

324

Thanks, Tim. Will do.

[PeteSteinfeld]

Changes in response to comments by Tim. Basically, better handling with
respect to moving data around by using rvalue references and eliminating
unnecessary use of the type "std::optional<>".

[tskeith]

flang/test/Evaluate/folding16.f90

6

I think you should be able to add this line to check the lower bound of c:
logical, parameter :: test_c = lbound(c, 1) == -1

But when I tried that it failed. (It's possible I don't understand these folding tests.)

[PeteSteinfeld]

flang/test/Evaluate/folding16.f90

6

Good catch! This test already has tests that test for the lower bound of arrays where the lower bound was negative, and the test was not reporting failure. It turns out, though, that the test itself was erroneous because the test script only checks for constants that begin with "test_". I will fix the test and the underlying bug.

I checked the other tests in this directory, and folding09.f90 has the same problem. Stay tuned for another change.

[PeteSteinfeld]

flang/test/Evaluate/folding16.f90

6

@tskeith, I've investigated this, and your test reveals two bugs, one with our tests and the other with constant folding of the intrinsic "lbound". Neither is related to the other changes in this commit, though.

So my plan is to merge this change request (almost) as is and then fix these other two bugs in a separate change. The one change I'll make is to the test folding16.f90 to enable the new tests I've added. Let me know if you think that's a bad idea.

[tskeith]

flang/test/Evaluate/folding16.f90

6

Sounds good to me.

[PeteSteinfeld]

Responsed to comments from Tim.

Tim noticed that constant folding for the intrinsic "lbounds" wasn't working,
even though we had a test for it which was passing. This revealed a problem in
our tests that I fixed. I'll fix the constant folding problem in a later
change.

flang/include/flang/Evaluate/tools.h

 
 // Common handling for procedure pointer compatibility of left- and right-hand
 // sides.  Returns nullopt if they're compatible.  Otherwise, it returns a
 // message that needs to be augmented by the names of the left and right sides
 std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
     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));
   }
 
 private:
   ConstantSubscripts extents_;
   std::optional<ConstantSubscripts> lbounds_;
 };
 

flang/lib/Evaluate/check-expression.cpp

public:
   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));
   }
 
 private:
   ConstantSubscripts shape_;
   std::optional<ConstantSubscripts> lbounds_;
 };
 
 // Converts, folds, and then checks type, rank, and shape of an
 // initialization expression for a named constant, a non-pointer
 // variable static initializatio, a component default initializer,
 // a type parameter default value, or instantiated type parameter value.
 std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
     Expr<SomeType> &&x, FoldingContext &context,
     const semantics::Scope *instantiation) {
   CHECK(!IsPointer(symbol));
   if (auto symTS{
           characteristics::TypeAndShape::Characterize(symbol, context)}) {
     auto xType{x.GetType()};
     if (auto converted{ConvertToType(symTS->type(), std::move(x))}) {
       auto folded{Fold(context, std::move(*converted))};
       if (IsActuallyConstant(folded)) {
         int symRank{GetRank(symTS->shape())};
         if (IsImpliedShape(symbol)) {
           if (folded.Rank() == symRank) {
             return {std::move(folded)};
           } else {
             context.messages().Say(
                 "Implied-shape parameter '%s' has rank %d but its initializer has rank %d"_err_en_US,
                 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)) {
           if (IsExplicitShape(symbol)) {
             context.messages().Say(
                 "Named constant '%s' array must have constant shape"_err_en_US,
                 symbol.name());
           } else {

flang/lib/Evaluate/fold.cpp

Expr<SomeDerived> FoldOperation(
   bool constantExtents{true};
   for (auto &&[symbol, value] : std::move(structure)) {
     auto expr{Fold(context, std::move(value.value()))};
     if (!IsPointer(symbol)) {
       bool ok{false};
       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 {
             ok = *valueShape == *componentShape;
           }
         }
       }
       if (!ok) {

flang/lib/Evaluate/shape.cpp

 MaybeExtentExpr GetExtent(FoldingContext &context, const Subscript &subscript,
     const NamedEntity &base, int dimension) {
   return Fold(context, GetExtent(subscript, base, dimension));
 }
 
 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;
   }
 }
 
 MaybeExtentExpr ComputeUpperBound(
     FoldingContext &context, ExtentExpr &&lower, MaybeExtentExpr &&extent) {
   return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent)));

flang/test/Evaluate/folding16.f90

 ! 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)
+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

flang/test/Semantics/array-constr-values.f90

subroutine arrayconstructorvalues()
   !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types INTEGER(4) and TYPE(base_type)
   !ERROR: ABSTRACT derived type 'base_type' may not be used in a structure constructor
   !ERROR: Values in array constructor must have the same declared type when no explicit type appears
   intarray = (/ base_type(10), 2, 3, 4, 5 /)
 end subroutine arrayconstructorvalues
 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) = &
     [ ((1.0, iDuplicate = 1,j), &
        (0.0, iDuplicate = j,3 ), &
         j = 1,5 ) ]
 end subroutine