[flang] Fix folding of ac-implied-do indices in structure c'tors

[klausler]

Summary

Array constructors with implied DO loops that oversee structure
constructors were being prematurely folded into invalid constants
containing symbolic references to the ac-implied-do indices,
because they are indeed "constant expressions" as that term is
used in the Fortran standard and implemented as IsConstantExpr().
What's actually needed in structure constructor folding is a
test for actual constant values, which is what results from
folding them later with repetition in the context of folding
an ac-implied-do.

flang/lib/Evaluate/fold-implementation.h

return FoldElementalIntrinsic<T, T, T, LogicalResult>(context,
           }));
 }
 
 Expr<ImpliedDoIndex::Result> FoldOperation(FoldingContext &, ImpliedDoIndex &&);
 
 // Array constructor folding
 template <typename T> class ArrayConstructorFolder {
 public:
-  explicit ArrayConstructorFolder(const FoldingContext &c) : context_{c} {}
+  explicit ArrayConstructorFolder(FoldingContext &c) : context_{c} {}
 
   Expr<T> FoldArray(ArrayConstructor<T> &&array) {
     // Calls FoldArray(const ArrayConstructorValues<T> &) below
     if (FoldArray(array)) {
       auto n{static_cast<ConstantSubscript>(elements_.size())};
       if constexpr (std::is_same_v<T, SomeDerived>) {
         return Expr<T>{Constant<T>{array.GetType().GetDerivedTypeSpec(),
             std::move(elements_), ConstantSubscripts{n}}};
       } else if constexpr (T::category == TypeCategory::Character) {
         auto length{Fold(context_, common::Clone(array.LEN()))};
         if (std::optional<ConstantSubscript> lengthValue{ToInt64(length)}) {
           return Expr<T>{Constant<T>{
               *lengthValue, std::move(elements_), ConstantSubscripts{n}}};
         }
       } else {
         return Expr<T>{
             Constant<T>{std::move(elements_), ConstantSubscripts{n}}};
       }
     }
     return Expr<T>{std::move(array)};
   }
 
 private:
-  bool FoldArray(const common::CopyableIndirection<Expr<T>> &expr) {
-    Expr<T> folded{Fold(context_, common::Clone(expr.value()))};
+  bool FoldArray(const Expr<T> &expr) {
+    Expr<T> folded{Fold(context_, common::Clone(expr))};
     if (const auto *c{UnwrapConstantValue<T>(folded)}) {
       // Copy elements in Fortran array element order
       if (!c->empty()) {
         ConstantSubscripts index{c->lbounds()};
         do {
           elements_.emplace_back(c->At(index));
         } while (c->IncrementSubscripts(index));
       }
       return true;
     } else {
       return false;
     }
   }
+  bool FoldArray(const common::CopyableIndirection<Expr<T>> &expr) {
+    return FoldArray(expr.value());
+  }
   bool FoldArray(const ImpliedDo<T> &iDo) {
     Expr<SubscriptInteger> lower{
         Fold(context_, Expr<SubscriptInteger>{iDo.lower()})};
     Expr<SubscriptInteger> upper{
         Fold(context_, Expr<SubscriptInteger>{iDo.upper()})};
     Expr<SubscriptInteger> stride{
         Fold(context_, Expr<SubscriptInteger>{iDo.stride()})};
     std::optional<ConstantSubscript> start{ToInt64(lower)}, end{ToInt64(upper)},
bool FoldArray(const ArrayConstructorValues<T> &xs) {
     for (const auto &x : xs) {
       if (!FoldArray(x)) {
         return false;
       }
     }
     return true;
   }
 
-  FoldingContext context_;
+  FoldingContext &context_;
   std::vector<Scalar<T>> elements_;
 };
 
 template <typename T>
 Expr<T> FoldOperation(FoldingContext &context, ArrayConstructor<T> &&array) {
   return ArrayConstructorFolder<T>{context}.FoldArray(std::move(array));
 }
 

flang/lib/Evaluate/fold.cpp

return std::visit(
           },
       },
       ss.u);
 }
 
 Expr<SomeDerived> FoldOperation(
     FoldingContext &context, StructureConstructor &&structure) {
   StructureConstructor ctor{structure.derivedTypeSpec()};
-  bool constantExtents{true};
+  bool isConstant{true};
   for (auto &&[symbol, value] : std::move(structure)) {
     auto expr{Fold(context, std::move(value.value()))};
-    if (!IsPointer(symbol)) {
-      bool ok{false};
+    if (IsPointer(symbol)) {
+      if (IsProcedure(symbol)) {
+        isConstant &= IsInitialProcedureTarget(expr);
+      } else {
+        isConstant &= IsInitialDataTarget(expr);
+      }
+    } else {
+      isConstant &= IsActuallyConstant(expr);
       if (auto valueShape{GetConstantExtents(context, expr)}) {
         if (auto componentShape{GetConstantExtents(context, symbol)}) {
           if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0) {
             expr = ScalarConstantExpander{std::move(*componentShape)}.Expand(
                 std::move(expr));
-            ok = expr.Rank() > 0;
+            isConstant &= expr.Rank() > 0;
           } else {
-            ok = *valueShape == *componentShape;
-          }
+            isConstant &= *valueShape == *componentShape;
           }
         }
-      if (!ok) {
-        constantExtents = false;
       }
     }
-    ctor.Add(symbol, Fold(context, std::move(expr)));
+    ctor.Add(symbol, std::move(expr));
   }
-  if (constantExtents && IsConstantExpr(ctor)) {
+  if (isConstant) {
     return Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}};
   } else {
     return Expr<SomeDerived>{std::move(ctor)};
   }
 }
 
 Component FoldOperation(FoldingContext &context, Component &&component) {
   return {FoldOperation(context, std::move(component.base())),

flang/test/Evaluate/folding30.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of structure constructors in array constructors
+module m
+  type :: t1
+    integer :: n
+  end type
+  type(t1), parameter :: xs1(*) = [(t1(j),j=1,5,2)]
+  type(t1), parameter :: xs2(*) = [(t1(j),j=5,1,-2)]
+  logical, parameter :: test_1 = all(xs1%n == [1, 3, 5])
+  logical, parameter :: test_2 = all(xs2%n == [5, 3, 1])
+end module