[flang] Fix LBOUND() folding for constant arrays

[FruitClover]

Summary

Previously constant folding uses 'dim' without checks which leads to ICE if we
do not have DIM= parameter. And for inputs without DIM= we need to form an
array of rank size with computed bounds instead of single value.

Add additional PackageConstant function to simplify 'if (dim)' handling since we
need to distinguish between scalar initialization in case of DIM= argument and
rank=1 array.

Also add a few more tests with 'parameter' type to verify folding for constant
arrays.

[klausler]

flang/lib/Evaluate/fold-integer.cpp

117

In the functional style used in the f18 frontend we prefer to use 'else' when there's an 'if' statement and following code that both end in returns.

The implementation might be clearer if GetConstantArrayLboundHelper were changed to return ConstantSubscripts (plural); the case with a DIM= argument could then extract its result from them, and the case without would simply return all of them.

[FruitClover]

Update GetConstantArrayLboundHelper impl., add PackageConstant variant.

[FruitClover]

flang/lib/Evaluate/fold-integer.cpp

117

Thanks, I've tried to switch to ConstantSubscripts variant, don't know if it's optimal solution with PackageConstant usage (since I'm not very confident in overall types structure yet).

[FruitClover]

UBOUND() has similar problem with constant arrays, created patch based on current changes (will rebase & update after current review) - https://reviews.llvm.org/D123520

[jeanPerier]

Thanks for working on a fix. I think there is a second issue that would be worth fixing while you are working on this. The PackageConstant looks good to me, but I would not expose it in a tools.h header when it is only really needed here. Please see my comment on your UBOUND patch. I think there is an opportunity to centralize more in GetConstantArrayHelper and make its interface even clearer.

flang/include/flang/Evaluate/tools.h

1044 ↗

(On Diff #421661)

I think PackageConstant is very specific to the LBOUND/UBOUND folding usage. I am not sure it is worth exposing it in this widely included header.

Looking at GetConstantArrayLboundHelper, it is only ever used in folding, so maybe PackageConstant could be moved inside it, or next to it if that brings too many templates.

flang/lib/Evaluate/fold-integer.cpp

57

Since you are fixing LBOUND and UBOUND bugs, I think this part of the previous code is incorrect, as far as I can tell, the lower bounds of (cst) are ones, not the ones of cst.

e.g:

   integer, parameter :: a3(2:4,4:6) = 0
   print *, LBOUND((a3), 1)
end

Should print 1, not 2, and I think returning GetLbound(x.left()) will cause it to return 2.

[FruitClover]

Apply review changes, update tests

[FruitClover]

Sync with main

[FruitClover]

flang/include/flang/Evaluate/tools.h

1044 ↗

(On Diff #421661)

Thanks a lot for details, moved the class closer.

flang/lib/Evaluate/fold-integer.cpp

57

Oh, that's an interesting case, submitted https://reviews.llvm.org/D123838 based on current PR.

[jeanPerier]

LGTM aside of the two style nits.

flang/lib/Evaluate/fold-integer.cpp

24

Prefer {} init instead of = init in semantics code.

115

Prefer {} init instead of = init in semantics code.

[FruitClover]

Switch = to {}

[klausler]

Please use braced initialization. It is safer.

[FruitClover]

In D123237#3459275, @klausler wrote:

Please use braced initialization. It is safer.

Sorry, already updated in previous push, other PR's in stack need only rebase.

flang/lib/Evaluate/fold-integer.cpp

 //===-- lib/Evaluate/fold-integer.cpp -------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "fold-implementation.h"
 #include "fold-reduction.h"
 #include "flang/Evaluate/check-expression.h"
 
 namespace Fortran::evaluate {
 
+// Given a collection of ConstantSubscripts values, package them as a Constant.
+// Return scalar value if asScalar == true and shape-dim array otherwise.
+template <typename T>
+Expr<T> PackageConstantBounds(
+    const ConstantSubscripts &&bounds, bool asScalar = false) {
+  if (asScalar) {
+    return Expr<T>{Constant<T>{bounds.at(0)}};
+  } else {
+    // As rank-dim array
+    const int rank{GetRank(bounds)};
+    std::vector<Scalar<T>> packed(rank);
+    std::transform(bounds.begin(), bounds.end(), packed.begin(),
+        [](ConstantSubscript x) { return Scalar<T>(x); });
+    return Expr<T>{Constant<T>{std::move(packed), ConstantSubscripts{rank}}};
+  }
+}
+
 // Class to retrieve the constant lower bound of an expression which is an
 // array that devolves to a type of Constant<T>
 class GetConstantArrayLboundHelper {
 public:
-  GetConstantArrayLboundHelper(ConstantSubscript dim) : dim_{dim} {}
+  GetConstantArrayLboundHelper(std::optional<ConstantSubscript> dim)
+      : dim_{dim} {}
 
-  template <typename T> ConstantSubscript GetLbound(const T &) {
+  template <typename T> ConstantSubscripts GetLbound(const T &) {
     // The method is needed for template expansion, but we should never get
     // here in practice.
     CHECK(false);
-    return 0;
+    return {0};
   }
 
-  template <typename T> ConstantSubscript GetLbound(const Constant<T> &x) {
+  template <typename T> ConstantSubscripts GetLbound(const Constant<T> &x) {
     // Return the lower bound
-    return x.lbounds()[dim_];
+    if (dim_) {
+      return {x.lbounds().at(*dim_)};
+    } else {
+      return x.lbounds();
+    }
   }
 
-  template <typename T> ConstantSubscript GetLbound(const Parentheses<T> &x) {
+  template <typename T> ConstantSubscripts GetLbound(const Parentheses<T> &x) {
     // Strip off the parentheses
     return GetLbound(x.left());
   }
 
-  template <typename T> ConstantSubscript GetLbound(const Expr<T> &x) {
+  template <typename T> ConstantSubscripts GetLbound(const Expr<T> &x) {
     // recurse through Expr<T>'a until we hit a constant
     return common::visit([&](const auto &inner) { return GetLbound(inner); },
         //      [&](const auto &) { return 0; },
         x.u);
   }
 
 private:
-  ConstantSubscript dim_;
+  std::optional<ConstantSubscript> dim_;
 };
 
 template <int KIND>
 Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Integer, KIND>;
   ActualArguments &args{funcRef.arguments()};
   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
if (int rank{array->Rank()}; rank > 0) {
             return Fold(context,
                 ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
           }
         } else {
           lowerBoundsAreOne = symbol.Rank() == 0; // LBOUND(array%component)
         }
       }
       if (IsActuallyConstant(*array)) {
-        return Expr<T>{GetConstantArrayLboundHelper{*dim}.GetLbound(*array)};
+        const ConstantSubscripts bounds{
+            GetConstantArrayLboundHelper{dim}.GetLbound(*array)};
+        return PackageConstantBounds<T>(std::move(bounds), dim.has_value());
       }
       if (lowerBoundsAreOne) {
-        if (dim) {
-          return Expr<T>{1};
-        } else {
-          std::vector<Scalar<T>> ones(rank, Scalar<T>{1});
-          return Expr<T>{
-              Constant<T>{std::move(ones), ConstantSubscripts{rank}}};
-        }
+        ConstantSubscripts ones(rank, ConstantSubscript{1});
+        return PackageConstantBounds<T>(std::move(ones), dim.has_value());
       }
     }
   }
   return Expr<T>{std::move(funcRef)};
 }
 
 template <int KIND>
 Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,

flang/test/Evaluate/folding08.f90

associate (b => a + 0)
       block
         integer, parameter :: lbb(*) = lbound(b)
         logical, parameter :: test_lbb = all(lbb == [1,1])
         integer, parameter :: ubb(*) = ubound(b)
         logical, parameter :: test_ubb = all(ubb == [2,3])
       end block
     end associate
   end subroutine
+  subroutine test3_lbound_parameter
+    ! Test lbound with constant arrays
+    integer, parameter :: a1(1) = 0
+    integer, parameter :: lba1(*) = lbound(a1)
+    logical, parameter :: test_lba1 = all(lba1 == [1])
+
+    integer, parameter :: a2(0:1) = 0
+    integer, parameter :: lba2(*) = lbound(a2)
+    logical, parameter :: test_lba2 = all(lba2 == [0])
+
+    integer, parameter :: a3(-10:-5,1,4:6) = 0
+    integer, parameter :: lba3(*) = lbound(a3)
+    logical, parameter :: test_lba3 = all(lba3 == [-10, 1, 4])
+    ! Exercise with DIM=
+    logical, parameter :: test_lba3_dim = lbound(a3, 1) == -10 .and. &
+         lbound(a3, 2) == 1 .and. &
+         lbound(a3, 3) == 4
+  end subroutine
 end