[flang] Fix crash in folding (#48437)

[klausler]

Summary

Elemental intrinsic function folding was not taking the lower
bounds of constant array arguments into account; these lower bounds
can be distinct from 1 when named constants appear as arguments.

LLVM bugzilla #48437.

[jeanPerier]

Looks good to me

flang/include/flang/Evaluate/constant.h

public:
   std::optional<Scalar<T>> GetScalarValue() const {
     if (ConstantBounds::Rank() == 0) {
       return Base::values_.at(0);
     } else {
       return std::nullopt;
     }
   }
 
-  // Apply subscripts.
+  // Apply subscripts.  An empty subscript list is allowed for
+  // a scalar constant.
   Element At(const ConstantSubscripts &) const;
 
   Constant Reshape(ConstantSubscripts &&) const;
   std::size_t CopyFrom(const Constant &source, std::size_t count,
       ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
 };
 
 template <int KIND>
public:
   std::optional<Scalar<Result>> GetScalarValue() const {
     if (Rank() == 0) {
       return values_;
     } else {
       return std::nullopt;
     }
   }
 
-  // Apply subscripts
+  // Apply subscripts, if any.
   Scalar<Result> At(const ConstantSubscripts &) const;
 
   Constant Reshape(ConstantSubscripts &&) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
   static constexpr DynamicType GetType() {
     return {TypeCategory::Character, KIND};
   }
   std::size_t CopyFrom(const Constant &source, std::size_t count,

flang/lib/Evaluate/fold-implementation.h

 Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
     FunctionRef<TR> &&funcRef, WrapperType<TR, TA...> func,
     std::index_sequence<I...>) {
   if (std::optional<std::tuple<const Constant<TA> *...>> args{
           GetConstantArguments<TA...>(context, funcRef.arguments())}) {
     // Compute the shape of the result based on shapes of arguments
     ConstantSubscripts shape;
     int rank{0};
-    const ConstantSubscripts *shapes[sizeof...(TA)]{
-        &std::get<I>(*args)->shape()...};
-    const int ranks[sizeof...(TA)]{std::get<I>(*args)->Rank()...};
+    const ConstantSubscripts *shapes[]{&std::get<I>(*args)->shape()...};
+    const int ranks[]{std::get<I>(*args)->Rank()...};
     for (unsigned int i{0}; i < sizeof...(TA); ++i) {
       if (ranks[i] > 0) {
         if (rank == 0) {
           rank = ranks[i];
           shape = *shapes[i];
         } else {
           if (shape != *shapes[i]) {
             // TODO: Rank compatibility was already checked but it seems to be
             // the first place where the actual shapes are checked to be the
             // same. Shouldn't this be checked elsewhere so that this is also
             // checked for non constexpr call to elemental intrinsics function?
             context.messages().Say(
                 "Arguments in elemental intrinsic function are not conformable"_err_en_US);
             return Expr<TR>{std::move(funcRef)};
           }
         }
       }
     }
     CHECK(rank == GetRank(shape));
 
     // Compute all the scalar values of the results
     std::vector<Scalar<TR>> results;
     if (TotalElementCount(shape) > 0) {
       ConstantBounds bounds{shape};
-      ConstantSubscripts index(rank, 1);
+      ConstantSubscripts resultIndex(rank, 1);
+      ConstantSubscripts argIndex[]{std::get<I>(*args)->lbounds()...};
       do {
         if constexpr (std::is_same_v<WrapperType<TR, TA...>,
                           ScalarFuncWithContext<TR, TA...>>) {
-          results.emplace_back(func(context,
-              (ranks[I] ? std::get<I>(*args)->At(index)
-                        : std::get<I>(*args)->GetScalarValue().value())...));
+          results.emplace_back(
+              func(context, std::get<I>(*args)->At(argIndex[I])...));
         } else if constexpr (std::is_same_v<WrapperType<TR, TA...>,
                                  ScalarFunc<TR, TA...>>) {
-          results.emplace_back(func(
-              (ranks[I] ? std::get<I>(*args)->At(index)
-                        : std::get<I>(*args)->GetScalarValue().value())...));
+          results.emplace_back(func(std::get<I>(*args)->At(argIndex[I])...));
         }
-      } while (bounds.IncrementSubscripts(index));
+        (std::get<I>(*args)->IncrementSubscripts(argIndex[I]), ...);
+      } while (bounds.IncrementSubscripts(resultIndex));
     }
     // Build and return constant result
     if constexpr (TR::category == TypeCategory::Character) {
       auto len{static_cast<ConstantSubscript>(
           results.size() ? results[0].length() : 0)};
       return Expr<TR>{Constant<TR>{len, std::move(results), std::move(shape)}};
     } else {
       return Expr<TR>{Constant<TR>{std::move(results), std::move(shape)}};
Expr<T> FoldArray(ArrayConstructor<T> &&array) {
     return Expr<T>{std::move(array)};
   }
 
 private:
   bool FoldArray(const common::CopyableIndirection<Expr<T>> &expr) {
     Expr<T> folded{Fold(context_, common::Clone(expr.value()))};
     if (const auto *c{UnwrapConstantValue<T>(folded)}) {
       // Copy elements in Fortran array element order
-      ConstantSubscripts shape{c->shape()};
-      int rank{c->Rank()};
-      ConstantSubscripts index(GetRank(shape), 1);
-      for (std::size_t n{c->size()}; n-- > 0;) {
+      if (c->size() > 0) {
+        ConstantSubscripts index{c->lbounds()};
+        do {
           elements_.emplace_back(c->At(index));
-        for (int d{0}; d < rank; ++d) {
-          if (++index[d] <= shape[d]) {
-            break;
-          }
-          index[d] = 1;
-        }
+        } while (c->IncrementSubscripts(index));
       }
       return true;
     } else {
       return false;
     }
   }
   bool FoldArray(const ImpliedDo<T> &iDo) {
     Expr<SubscriptInteger> lower{

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)
+logical, parameter :: test = lbound(a,1)==-1 .and. lbound(b,1)==-1 .and. &
+                             lbound(log(a),1)==1 .and. all(b==0)
+end