diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/include/flang/Evaluate/shape.h @@ -60,13 +60,25 @@ std::optional GetShape(FoldingContext &, const A &); template std::optional GetShape(const A &); -// The dimension argument to these inquiries is zero-based, -// unlike the DIM= arguments to many intrinsics. -ExtentExpr GetLowerBound(const NamedEntity &, int dimension); -ExtentExpr GetLowerBound(FoldingContext &, const NamedEntity &, int dimension); -MaybeExtentExpr GetUpperBound(const NamedEntity &, int dimension); -MaybeExtentExpr GetUpperBound( - FoldingContext &, const NamedEntity &, int dimension); +// Notes about GetLowerBound and GetUpperBound: +// - The dimension argument to these inquiries is zero-based, +// unlike the DIM= arguments to many intrinsics. +// - Shape analysis results might be used outside of the specification part, +// in which case it is not possible to inject a non constant specification +// expression because it may evaluate to a different value than it did in +// the specification part. In contexts where it is known to be possible to +// use such non constant specification expressions, the flag +// useNonConstantExplicitBounds can be set to true. Otherwise, +// evaluate::DescriptorInquiry will be returned for non constant explicit +// bounds. +ExtentExpr GetLowerBound(const NamedEntity &, int dimension, + bool useNonConstantExplicitBounds = false); +ExtentExpr GetLowerBound(FoldingContext &, const NamedEntity &, int dimension, + bool useNonConstantExplicitBounds = false); +MaybeExtentExpr GetUpperBound(const NamedEntity &, int dimension, + bool useNonConstantExplicitBounds = false); +MaybeExtentExpr GetUpperBound(FoldingContext &, const NamedEntity &, + int dimension, bool useNonConstantExplicitBounds = false); MaybeExtentExpr ComputeUpperBound(ExtentExpr &&lower, MaybeExtentExpr &&extent); MaybeExtentExpr ComputeUpperBound( FoldingContext &, ExtentExpr &&lower, MaybeExtentExpr &&extent); diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -10,6 +10,7 @@ #include "flang/Common/idioms.h" #include "flang/Common/template.h" #include "flang/Evaluate/characteristics.h" +#include "flang/Evaluate/check-expression.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/intrinsics.h" #include "flang/Evaluate/tools.h" @@ -232,7 +233,8 @@ using Result = ExtentExpr; using Base = Traverse; using Base::operator(); - explicit GetLowerBoundHelper(int d) : Base{*this}, dimension_{d} {} + explicit GetLowerBoundHelper(int d, bool b) + : Base{*this}, dimension_{d}, useNonConstantExplicitBounds_{b} {} static ExtentExpr Default() { return ExtentExpr{1}; } static ExtentExpr Combine(Result &&, Result &&) { return Default(); } ExtentExpr operator()(const Symbol &); @@ -240,15 +242,27 @@ private: int dimension_; + bool useNonConstantExplicitBounds_; }; +static const ExtentExpr *GetIfConstantExpr( + const semantics::Bound &bound, bool useNonConstantExplicitBounds = false) { + if (const auto &expr{bound.GetExplicit()}) { + if (useNonConstantExplicitBounds || IsConstantExpr(*expr)) { + return &*expr; + } + } + return nullptr; +} + auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result { const Symbol &symbol{symbol0.GetUltimate()}; if (const auto *details{symbol.detailsIf()}) { int j{0}; for (const auto &shapeSpec : details->shape()) { if (j++ == dimension_) { - if (const auto &bound{shapeSpec.lbound().GetExplicit()}) { + if (const auto *bound{GetIfConstantExpr( + shapeSpec.lbound(), useNonConstantExplicitBounds_)}) { return *bound; } else if (IsDescriptor(symbol)) { return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0}, @@ -273,7 +287,8 @@ int j{0}; for (const auto &shapeSpec : details->shape()) { if (j++ == dimension_) { - if (const auto &bound{shapeSpec.lbound().GetExplicit()}) { + if (const auto *bound{GetIfConstantExpr( + shapeSpec.lbound(), useNonConstantExplicitBounds_)}) { return *bound; } else if (IsDescriptor(symbol)) { return ExtentExpr{ @@ -289,13 +304,15 @@ return Default(); } -ExtentExpr GetLowerBound(const NamedEntity &base, int dimension) { - return GetLowerBoundHelper{dimension}(base); +ExtentExpr GetLowerBound( + const NamedEntity &base, int dimension, bool useNonConstantExplicitBounds) { + return GetLowerBoundHelper{dimension, useNonConstantExplicitBounds}(base); } -ExtentExpr GetLowerBound( - FoldingContext &context, const NamedEntity &base, int dimension) { - return Fold(context, GetLowerBound(base, dimension)); +ExtentExpr GetLowerBound(FoldingContext &context, const NamedEntity &base, + int dimension, bool useNonConstantExplicitBounds) { + return Fold( + context, GetLowerBound(base, dimension, useNonConstantExplicitBounds)); } Shape GetLowerBounds(const NamedEntity &base) { @@ -330,15 +347,13 @@ int j{0}; for (const auto &shapeSpec : details->shape()) { if (j++ == dimension) { - if (shapeSpec.ubound().isExplicit()) { - if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) { - if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) { - return common::Clone(ubound.value()) - - common::Clone(lbound.value()) + ExtentExpr{1}; - } else { - return ubound.value(); - } - } + const auto *ubound{GetIfConstantExpr(shapeSpec.ubound())}; + const auto *lbound{GetIfConstantExpr(shapeSpec.lbound())}; + if (ubound && lbound) { + return common::Clone(*ubound) - common::Clone(*lbound) + + ExtentExpr{1}; + } else if (ubound && !shapeSpec.lbound().isExplicit()) { + return *ubound; } else if (details->IsAssumedSize() && j == symbol.Rank()) { return std::nullopt; } else if (semantics::IsDescriptor(symbol)) { @@ -412,13 +427,15 @@ return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent))); } -MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) { +MaybeExtentExpr GetUpperBound( + const NamedEntity &base, int dimension, bool useNonConstantExplicitBounds) { const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())}; if (const auto *details{symbol.detailsIf()}) { int j{0}; for (const auto &shapeSpec : details->shape()) { if (j++ == dimension) { - if (const auto &bound{shapeSpec.ubound().GetExplicit()}) { + if (const auto *bound{GetIfConstantExpr( + shapeSpec.ubound(), useNonConstantExplicitBounds)}) { return *bound; } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) { break; @@ -440,9 +457,10 @@ return std::nullopt; } -MaybeExtentExpr GetUpperBound( - FoldingContext &context, const NamedEntity &base, int dimension) { - return Fold(context, GetUpperBound(base, dimension)); +MaybeExtentExpr GetUpperBound(FoldingContext &context, const NamedEntity &base, + int dimension, bool useNonConstantExplicitBounds) { + return Fold( + context, GetUpperBound(base, dimension, useNonConstantExplicitBounds)); } Shape GetUpperBounds(const NamedEntity &base) { @@ -451,7 +469,7 @@ Shape result; int dim{0}; for (const auto &shapeSpec : details->shape()) { - if (const auto &bound{shapeSpec.ubound().GetExplicit()}) { + if (const auto *bound{GetIfConstantExpr(shapeSpec.ubound())}) { result.push_back(*bound); } else if (details->IsAssumedSize()) { CHECK(dim + 1 == base.Rank()); diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -702,11 +702,18 @@ std::vector bounds; evaluate::NamedEntity entity{symbol}; for (int j{0}; j < rank; ++j) { - bounds.emplace_back(GetValue(std::make_optional(evaluate::GetLowerBound( - foldingContext, entity, j)), + // Force usage of length parameters in bound expressions instead of + // replacing their appearances by evaluate::DescriptorInquiry. + // Bounds dependency on length parameters will be translated in + // the generated type-info. + const bool useNonConstantExplicitExpr{true}; + bounds.emplace_back( + GetValue(std::make_optional(evaluate::GetLowerBound( + foldingContext, entity, j, useNonConstantExplicitExpr)), + parameters)); + bounds.emplace_back(GetValue(evaluate::GetUpperBound(foldingContext, + entity, j, useNonConstantExplicitExpr), parameters)); - bounds.emplace_back(GetValue( - evaluate::GetUpperBound(foldingContext, entity, j), parameters)); } AddValue(values, componentSchema_, "bounds"s, SaveDerivedPointerTarget(scope, diff --git a/flang/test/Semantics/modfile33.f90 b/flang/test/Semantics/modfile33.f90 --- a/flang/test/Semantics/modfile33.f90 +++ b/flang/test/Semantics/modfile33.f90 @@ -573,7 +573,7 @@ ! real(4) :: x ! real(4) :: y(1_8:4_8, 1_8:n) ! real(4) :: z(1_8:2_8, 1_8:2_8, 1_8:2_8) -! real(4) :: a(1_8:int(int(4_8*(n-1_8+1_8),kind=4),kind=8)) +! real(4) :: a(1_8:int(int(4_8*size(y,dim=2),kind=4),kind=8)) ! real(4) :: b(1_8:add(y, z)) ! end !end