[flang] Preserve component array lower bounds in folding

[klausler]

Summary

When a component array of a named constant is extracted as
a constant value, ensure that the lower bounds of the array
are properly acquired from the declaration of the component.

[clementval]

LGTM

flang/include/flang/Evaluate/tools.h

 std::optional<Expr<SomeType>> DataConstantConversionExtension(
     FoldingContext &, const DynamicType &, const Expr<SomeType> &);
 
 // Convert Hollerith or short character to a another type as if the
 // Hollerith data had been BOZ.
 std::optional<Expr<SomeType>> HollerithToBOZ(
     FoldingContext &, const Expr<SomeType> &, const DynamicType &);
 
+// Set explicit lower bounds on a constant array.
+class ArrayConstantBoundChanger {
+public:
+  explicit ArrayConstantBoundChanger(ConstantSubscripts &&lbounds)
+      : lbounds_{std::move(lbounds)} {}
+
+  template <typename A> A ChangeLbounds(A &&x) const {
+    return std::move(x); // default case
+  }
+  template <typename T> Constant<T> ChangeLbounds(Constant<T> &&x) {
+    x.set_lbounds(std::move(lbounds_));
+    return std::move(x);
+  }
+  template <typename T> Expr<T> ChangeLbounds(Parentheses<T> &&x) {
+    return ChangeLbounds(
+        std::move(x.left())); // Constant<> can be parenthesized
+  }
+  template <typename T> Expr<T> ChangeLbounds(Expr<T> &&x) {
+    return common::visit(
+        [&](auto &&x) { return Expr<T>{ChangeLbounds(std::move(x))}; },
+        std::move(x.u)); // recurse until we hit a constant
+  }
+
+private:
+  ConstantSubscripts &&lbounds_;
+};
+
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 
 class Scope;
 
 // If a symbol represents an ENTRY, return the symbol of the main entry
 // point to its subprogram.

flang/lib/Evaluate/check-expression.cpp

 //===-- lib/Evaluate/check-expression.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 "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/intrinsics.h"
+#include "flang/Evaluate/tools.h"
 #include "flang/Evaluate/traverse.h"
 #include "flang/Evaluate/type.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include <set>
 #include <string>
 
 namespace Fortran::evaluate {

 bool IsInitialProcedureTarget(const Expr<SomeType> &expr) {
   if (const auto *proc{std::get_if<ProcedureDesignator>(&expr.u)}) {
     return IsInitialProcedureTarget(*proc);
   } else {
     return IsNullProcedurePointer(expr);
   }
 }
 
-class ArrayConstantBoundChanger {
-public:
-  ArrayConstantBoundChanger(ConstantSubscripts &&lbounds)
-      : lbounds_{std::move(lbounds)} {}
-
-  template <typename A> A ChangeLbounds(A &&x) const {
-    return std::move(x); // default case
-  }
-  template <typename T> Constant<T> ChangeLbounds(Constant<T> &&x) {
-    x.set_lbounds(std::move(lbounds_));
-    return std::move(x);
-  }
-  template <typename T> Expr<T> ChangeLbounds(Parentheses<T> &&x) {
-    return ChangeLbounds(
-        std::move(x.left())); // Constant<> can be parenthesized
-  }
-  template <typename T> Expr<T> ChangeLbounds(Expr<T> &&x) {
-    return common::visit(
-        [&](auto &&x) { return Expr<T>{ChangeLbounds(std::move(x))}; },
-        std::move(x.u)); // recurse until we hit a constant
-  }
-
-private:
-  ConstantSubscripts &&lbounds_;
-};
-
 // Converts, folds, and then checks type, rank, and shape of an
 // initialization expression for a named constant, a non-pointer
 // variable static initialization, a component default initializer,
 // a type parameter default value, or instantiated type parameter value.
 std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
     Expr<SomeType> &&x, FoldingContext &context,
     const semantics::Scope *instantiation) {
   CHECK(!IsPointer(symbol));

flang/lib/Evaluate/fold.cpp

 //===-- lib/Evaluate/fold.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 "flang/Evaluate/fold.h"
 #include "fold-implementation.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/initial-image.h"
+#include "flang/Evaluate/tools.h"
 
 namespace Fortran::evaluate {
 
 characteristics::TypeAndShape Fold(
     FoldingContext &context, characteristics::TypeAndShape &&x) {
   x.Rewrite(context);
   return std::move(x);
 }
if (IsPointer(symbol)) {
         if (auto componentShape{GetConstantExtents(context, symbol)}) {
           if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {
             expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(
                 std::move(expr));
             isConstant &= expr.Rank() > 0;
           } else {
             isConstant &= *valueShape == *componentShape;
           }
+          if (*valueShape == *componentShape) {
+            if (auto lbounds{AsConstantExtents(
+                    context, GetLBOUNDs(context, NamedEntity{symbol}))}) {
+              expr =
+                  ArrayConstantBoundChanger{std::move(*lbounds)}.ChangeLbounds(
+                      std::move(expr));
+            }
+          }
         }
       }
     }
     ctor.Add(symbol, std::move(expr));
   }
   if (isConstant) {
     return Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}};
   } else {