diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 93e900b9e7e0..dc0c02669cbe 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1109,6 +1109,33 @@ std::optional> DataConstantConversionExtension( std::optional> HollerithToBOZ( FoldingContext &, const Expr &, const DynamicType &); +// Set explicit lower bounds on a constant array. +class ArrayConstantBoundChanger { +public: + explicit ArrayConstantBoundChanger(ConstantSubscripts &&lbounds) + : lbounds_{std::move(lbounds)} {} + + template A ChangeLbounds(A &&x) const { + return std::move(x); // default case + } + template Constant ChangeLbounds(Constant &&x) { + x.set_lbounds(std::move(lbounds_)); + return std::move(x); + } + template Expr ChangeLbounds(Parentheses &&x) { + return ChangeLbounds( + std::move(x.left())); // Constant<> can be parenthesized + } + template Expr ChangeLbounds(Expr &&x) { + return common::visit( + [&](auto &&x) { return Expr{ChangeLbounds(std::move(x))}; }, + std::move(x.u)); // recurse until we hit a constant + } + +private: + ConstantSubscripts &&lbounds_; +}; + } // namespace Fortran::evaluate namespace Fortran::semantics { diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 4d5fd0ba9fab..34ade7157144 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -9,6 +9,7 @@ #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" @@ -363,32 +364,6 @@ bool IsInitialProcedureTarget(const Expr &expr) { } } -class ArrayConstantBoundChanger { -public: - ArrayConstantBoundChanger(ConstantSubscripts &&lbounds) - : lbounds_{std::move(lbounds)} {} - - template A ChangeLbounds(A &&x) const { - return std::move(x); // default case - } - template Constant ChangeLbounds(Constant &&x) { - x.set_lbounds(std::move(lbounds_)); - return std::move(x); - } - template Expr ChangeLbounds(Parentheses &&x) { - return ChangeLbounds( - std::move(x.left())); // Constant<> can be parenthesized - } - template Expr ChangeLbounds(Expr &&x) { - return common::visit( - [&](auto &&x) { return Expr{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, diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp index 2f4ba2ae5ee1..3073aec2c6c7 100644 --- a/flang/lib/Evaluate/fold.cpp +++ b/flang/lib/Evaluate/fold.cpp @@ -10,6 +10,7 @@ #include "fold-implementation.h" #include "flang/Evaluate/characteristics.h" #include "flang/Evaluate/initial-image.h" +#include "flang/Evaluate/tools.h" namespace Fortran::evaluate { @@ -92,6 +93,14 @@ Expr FoldOperation( } 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)); + } + } } } }