[flang] Fix calls to LBOUND() intrinsic for arrays with lower bounds not 1

[PeteSteinfeld]

Summary

Constant folding for calls to LBOUND() was not working when the lower bound of
a constant array was not 1.

I fixed this and re-enabled the test in Evaluate/folding16.f90 that previously
was silently failing. I slightly changed the test to parenthesize the first
argument to exercise all of the new code.

[tskeith]

flang/lib/Evaluate/fold-integer.cpp

91

I noticed we already have UnwrapConstantValue, so I think you could write this as:

if (auto *constant{UnwrapConstantValue(*array)}) {
  return Expr<T>(constant->lbounds()[*dim]);
}

[PeteSteinfeld]

flang/lib/Evaluate/fold-integer.cpp

91

I have to confess that I find the interaction between the C++ types used in expression processing and template expansion confusing. But here's why I don't think I can use "UnwrapConstantValue".

Note that "UnwrapConstantValue" is a template function, so to call it, you need to supply a template parameter, something like:

if (auto *constant{UnwrapConstantValue<T>(*array)}) {
  return Expr<T>(constant->lbounds()[*dim]);
}

At this point in the code, the type of "T" is "Type<TypeCategory::Integer, KIND>". But the type needed to instantiate "UnwrapConstantValue" is the type of the first argument to LBOUND() which could be an array of any type. So if the type of the array is INTEGER, your suggestion might work. But it won't work if the argument is an array of type REAL.

The variable that contains the value of this first argument is "array". The type of "array" is "evaluate::Expr<SomeType>". So the type needed to correctly instantiate "UnwrapConstantValue" is wrapped up in the "evaluate::Expr<SomeType>", and I couldn't figure out how to extract it in a way to use it for the instantiation. So I wrote the class "GetConstantArrayLboundHelper" which extracts the lower bound without knowing the type of the array.

It's quite possible that there's a C++ technique that would let me avoid writing the class "GetConstantArrayLboundHelper". But I don't know what it is.

[tskeith]

flang/lib/Evaluate/fold-integer.cpp

91

OK, thanks for the explanation.

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 "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} {}
+
+  template <typename T> ConstantSubscript GetLbound(const T &) {
+    // The method is needed for template expansion, but we should never get
+    // here in practice.
+    CHECK(false);
+    return 0;
+  }
+
+  template <typename T> ConstantSubscript GetLbound(const Constant<T> &x) {
+    // Return the lower bound
+    return x.lbounds()[dim_];
+  }
+
+  template <typename T> ConstantSubscript GetLbound(const Parentheses<T> &x) {
+    // Strip off the parentheses
+    return GetLbound(x.left());
+  }
+
+  template <typename T> ConstantSubscript 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_;
+};
+
 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) {
       std::optional<int> dim;
if (int rank{array->Rank()}; rank > 0) {
                          AsExtentArrayExpr(GetLowerBounds(context, *named))}) {
             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)};
+      }
       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}}};
         }

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
 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_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