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

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.

Differential Revision: https://reviews.llvm.org/D95894

2 files changed, 40 insertions, 4 deletions

diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 9f3482d..eea7b6e 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -7,9 +7,44 @@
 //===----------------------------------------------------------------------===//
 
 #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) {
@@ -51,6 +86,9 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
           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};
diff --git a/flang/test/Evaluate/folding16.f90 b/flang/test/Evaluate/folding16.f90
index a21f5a7..ac4550a 100644
--- a/flang/test/Evaluate/folding16.f90
+++ b/flang/test/Evaluate/folding16.f90
@@ -7,10 +7,8 @@ module m
   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)