diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -12,30 +12,52 @@ namespace Fortran::evaluate { +// Given a collection of ConstantSubscripts values, package them as a Constant. +// Return scalar value if asScalar == true and shape-dim array otherwise. +template +Expr PackageConstantBounds( + const ConstantSubscripts &&bounds, bool asScalar = false) { + if (asScalar) { + return Expr{Constant{bounds.at(0)}}; + } else { + // As rank-dim array + const int rank{GetRank(bounds)}; + std::vector> packed(rank); + std::transform(bounds.begin(), bounds.end(), packed.begin(), + [](ConstantSubscript x) { return Scalar(x); }); + return Expr{Constant{std::move(packed), ConstantSubscripts{rank}}}; + } +} + // Class to retrieve the constant lower bound of an expression which is an // array that devolves to a type of Constant class GetConstantArrayLboundHelper { public: - GetConstantArrayLboundHelper(ConstantSubscript dim) : dim_{dim} {} + GetConstantArrayLboundHelper(std::optional dim) + : dim_{dim} {} - template ConstantSubscript GetLbound(const T &) { + template ConstantSubscripts GetLbound(const T &) { // The method is needed for template expansion, but we should never get // here in practice. CHECK(false); - return 0; + return {0}; } - template ConstantSubscript GetLbound(const Constant &x) { + template ConstantSubscripts GetLbound(const Constant &x) { // Return the lower bound - return x.lbounds()[dim_]; + if (dim_) { + return {x.lbounds().at(*dim_)}; + } else { + return x.lbounds(); + } } - template ConstantSubscript GetLbound(const Parentheses &x) { + template ConstantSubscripts GetLbound(const Parentheses &x) { // Strip off the parentheses return GetLbound(x.left()); } - template ConstantSubscript GetLbound(const Expr &x) { + template ConstantSubscripts GetLbound(const Expr &x) { // recurse through Expr'a until we hit a constant return common::visit([&](const auto &inner) { return GetLbound(inner); }, // [&](const auto &) { return 0; }, @@ -43,7 +65,7 @@ } private: - ConstantSubscript dim_; + std::optional dim_; }; template @@ -89,16 +111,13 @@ } } if (IsActuallyConstant(*array)) { - return Expr{GetConstantArrayLboundHelper{*dim}.GetLbound(*array)}; + const ConstantSubscripts bounds{ + GetConstantArrayLboundHelper{dim}.GetLbound(*array)}; + return PackageConstantBounds(std::move(bounds), dim.has_value()); } if (lowerBoundsAreOne) { - if (dim) { - return Expr{1}; - } else { - std::vector> ones(rank, Scalar{1}); - return Expr{ - Constant{std::move(ones), ConstantSubscripts{rank}}}; - } + ConstantSubscripts ones(rank, ConstantSubscript{1}); + return PackageConstantBounds(std::move(ones), dim.has_value()); } } } diff --git a/flang/test/Evaluate/folding08.f90 b/flang/test/Evaluate/folding08.f90 --- a/flang/test/Evaluate/folding08.f90 +++ b/flang/test/Evaluate/folding08.f90 @@ -77,4 +77,22 @@ end block end associate end subroutine + subroutine test3_lbound_parameter + ! Test lbound with constant arrays + integer, parameter :: a1(1) = 0 + integer, parameter :: lba1(*) = lbound(a1) + logical, parameter :: test_lba1 = all(lba1 == [1]) + + integer, parameter :: a2(0:1) = 0 + integer, parameter :: lba2(*) = lbound(a2) + logical, parameter :: test_lba2 = all(lba2 == [0]) + + integer, parameter :: a3(-10:-5,1,4:6) = 0 + integer, parameter :: lba3(*) = lbound(a3) + logical, parameter :: test_lba3 = all(lba3 == [-10, 1, 4]) + ! Exercise with DIM= + logical, parameter :: test_lba3_dim = lbound(a3, 1) == -10 .and. & + lbound(a3, 2) == 1 .and. & + lbound(a3, 3) == 4 + end subroutine end