diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1094,7 +1094,7 @@ // Array constructor folding template class ArrayConstructorFolder { public: - explicit ArrayConstructorFolder(const FoldingContext &c) : context_{c} {} + explicit ArrayConstructorFolder(FoldingContext &c) : context_{c} {} Expr FoldArray(ArrayConstructor &&array) { // Calls FoldArray(const ArrayConstructorValues &) below @@ -1118,8 +1118,8 @@ } private: - bool FoldArray(const common::CopyableIndirection> &expr) { - Expr folded{Fold(context_, common::Clone(expr.value()))}; + bool FoldArray(const Expr &expr) { + Expr folded{Fold(context_, common::Clone(expr))}; if (const auto *c{UnwrapConstantValue(folded)}) { // Copy elements in Fortran array element order if (!c->empty()) { @@ -1133,6 +1133,9 @@ return false; } } + bool FoldArray(const common::CopyableIndirection> &expr) { + return FoldArray(expr.value()); + } bool FoldArray(const ImpliedDo &iDo) { Expr lower{ Fold(context_, Expr{iDo.lower()})}; @@ -1172,7 +1175,7 @@ return true; } - FoldingContext context_; + FoldingContext &context_; std::vector> elements_; }; diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp --- a/flang/lib/Evaluate/fold.cpp +++ b/flang/lib/Evaluate/fold.cpp @@ -65,29 +65,32 @@ Expr 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{Constant{std::move(ctor)}}; } else { return Expr{std::move(ctor)}; diff --git a/flang/test/Evaluate/folding30.f90 b/flang/test/Evaluate/folding30.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Evaluate/folding30.f90 @@ -0,0 +1,11 @@ +! 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