diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 212356136d6e..74c6acbcb1ed 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1144,15 +1144,14 @@ std::optional FindImpureCall( std::optional FindImpureCall( FoldingContext &, const ProcedureRef &); -// Predicate: is a scalar expression suitable for naive scalar expansion -// in the flattening of an array expression? -// TODO: capture such scalar expansions in temporaries, flatten everything -class UnexpandabilityFindingVisitor - : public AnyTraverse { +// Predicate: does an expression contain anything that would prevent it from +// being duplicated so that two instances of it then appear in the same +// expression? +class UnsafeToCopyVisitor : public AnyTraverse { public: - using Base = AnyTraverse; + using Base = AnyTraverse; using Base::operator(); - explicit UnexpandabilityFindingVisitor(bool admitPureCall) + explicit UnsafeToCopyVisitor(bool admitPureCall) : Base{*this}, admitPureCall_{admitPureCall} {} template bool operator()(const FunctionRef &procRef) { return !admitPureCall_ || !procRef.proc().IsPure(); @@ -1163,14 +1162,22 @@ private: bool admitPureCall_{false}; }; +template +bool IsSafelyCopyable(const A &x, bool admitPureCall = false) { + return !UnsafeToCopyVisitor{admitPureCall}(x); +} + +// Predicate: is a scalar expression suitable for naive scalar expansion +// in the flattening of an array expression? +// TODO: capture such scalar expansions in temporaries, flatten everything template bool IsExpandableScalar(const Expr &expr, FoldingContext &context, const Shape &shape, bool admitPureCall = false) { - if (UnexpandabilityFindingVisitor{admitPureCall}(expr)) { + if (IsSafelyCopyable(expr, admitPureCall)) { + return true; + } else { auto extents{AsConstantExtents(context, shape)}; return extents && !HasNegativeExtent(*extents) && GetSize(*extents) == 1; - } else { - return true; } } diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index 776866d1416d..894049f32a6b 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -623,7 +623,7 @@ MaybeExtentExpr GetRawUpperBound( } else if (semantics::IsAssumedSizeArray(symbol) && dimension + 1 == symbol.Rank()) { return std::nullopt; - } else { + } else if (IsSafelyCopyable(base, /*admitPureCall=*/true)) { return ComputeUpperBound( GetRawLowerBound(base, dimension), GetExtent(base, dimension)); } @@ -678,9 +678,11 @@ static MaybeExtentExpr GetUBOUND(FoldingContext *context, } else if (semantics::IsAssumedSizeArray(symbol) && dimension + 1 == symbol.Rank()) { return std::nullopt; // UBOUND() folding replaces with -1 - } else if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) { - return ComputeUpperBound( - std::move(*lb), GetExtent(base, dimension, invariantOnly)); + } else if (IsSafelyCopyable(base, /*admitPureCall=*/true)) { + if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) { + return ComputeUpperBound( + std::move(*lb), GetExtent(base, dimension, invariantOnly)); + } } } } else if (const auto *assoc{ diff --git a/flang/test/Evaluate/bug153031.f90 b/flang/test/Evaluate/bug153031.f90 new file mode 100644 index 000000000000..a717954ecaed --- /dev/null +++ b/flang/test/Evaluate/bug153031.f90 @@ -0,0 +1,18 @@ +! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s +! Ensure that UBOUND() calculation from LBOUND()+SIZE() isn't applied to +! variables containing references to impure functions. +type t + real, allocatable :: a(:) +end type +interface + pure integer function pure(n) + integer, intent(in) :: n + end +end interface +type(t) :: x(10) +allocate(x(1)%a(2)) +!CHECK: PRINT *, ubound(x(int(impure(1_4),kind=8))%a,dim=1_4) +print *, ubound(x(impure(1))%a, dim=1) +!CHECK: PRINT *, int(size(x(int(pure(1_4),kind=8))%a,dim=1,kind=8)+lbound(x(int(pure(1_4),kind=8))%a,dim=1,kind=8)-1_8,kind=4) +print *, ubound(x(pure(1))%a, dim=1) +end