[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

100

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

100

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

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

40

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

Thanks a lot for details, moved the class closer.

flang/lib/Evaluate/fold-integer.cpp

40

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.

98

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/include/flang/Evaluate/tools.h

Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements,
   } else if constexpr (T::category == TypeCategory::Derived) {
     return Constant<T>{reference.GetType().GetDerivedTypeSpec(),
         std::move(elements), ConstantSubscripts{shape}};
   } else {
     return Constant<T>{std::move(elements), ConstantSubscripts{shape}};
   }
 }
 
+// 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>
+Constant<T> PackageConstant(
+    const ConstantSubscripts &&bounds, bool asScalar = false) {
+  if (asScalar) {
+    return 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 Constant<T>{std::move(packed), ConstantSubscripts{rank}};
+  }
+}
+
 // Nonstandard conversions of constants (integer->logical, logical->integer)
 // that can appear in DATA statements as an extension.
 std::optional<Expr<SomeType>> DataConstantConversionExtension(
     FoldingContext &, const DynamicType &, const Expr<SomeType> &);
 
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {

flang/lib/Evaluate/fold-integer.cpp

 #include "flang/Evaluate/check-expression.h"
 
 namespace Fortran::evaluate {
 
 // 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 std::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 Expr<T>{PackageConstant<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 Expr<T>{PackageConstant<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(2:4,4:6) = 0
+    integer, parameter :: lba3(*) = lbound(a3)
+    logical, parameter :: test_lba3 = all(lba3 == [2, 4])
+
+    integer, parameter :: a4(2:4,1,4:6) = 0
+    integer, parameter :: lba4(*) = lbound(a4)
+    logical, parameter :: test_lba4 = all(lba4 == [2, 1, 4])
+  end subroutine
 end