[flang-commits] [flang] 20103ee - [flang] Fix exposed "free" instances of ac-implied-do indices (#178516)
via flang-commits
flang-commits at lists.llvm.org
Sat Jan 31 14:47:33 PST 2026
Author: Peter Klausler
Date: 2026-01-31T14:47:29-08:00
New Revision: 20103eeb3a261cd5b96135ee199da50b33688a77
URL: https://github.com/llvm/llvm-project/commit/20103eeb3a261cd5b96135ee199da50b33688a77
DIFF: https://github.com/llvm/llvm-project/commit/20103eeb3a261cd5b96135ee199da50b33688a77.diff
LOG: [flang] Fix exposed "free" instances of ac-implied-do indices (#178516)
Tweak the implementations of IsConstantExpr, IsInitialDataTarget, and
related utilities so that "free" instances of array constructor implied
DO indices are not treated as constant expressions when the surrounding
context (if any) doesn't contain their bounds. This fixes a current bug
in which a "free" implied DO index in a structure constructor got
wrapped up an a Constant<SomeDerived>, which led to a crash in lowering.
Added:
flang/test/Semantics/ac-impl-do-data-ptr.f90
Modified:
flang/include/flang/Evaluate/check-expression.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/fold.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/shape.cpp
flang/lib/Semantics/check-data.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/pointer-assignment.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index d11fe22c0be7b..41a98a4bea6a2 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -28,20 +28,34 @@ namespace Fortran::evaluate {
// Predicate: true when an expression is a constant expression (in the
// strict sense of the Fortran standard); it may not (yet) be a hard
// constant value.
-template <typename A> bool IsConstantExpr(const A &);
-extern template bool IsConstantExpr(const Expr<SomeType> &);
-extern template bool IsConstantExpr(const Expr<SomeInteger> &);
-extern template bool IsConstantExpr(const Expr<SubscriptInteger> &);
-extern template bool IsConstantExpr(const StructureConstructor &);
+// The FoldingContext pointer, if not null, prevents a "free" implied
+// DO index from being allowed in a constant expression or initial data
+// target if it is not registered in the FoldingContext. (Array constructor
+// implied DO indices are always allowed when the implied DO is within
+// the expression.)
+template <typename A>
+bool IsConstantExpr(const A &, const FoldingContext * = nullptr);
+extern template bool IsConstantExpr(
+ const Expr<SomeType> &, const FoldingContext *);
+extern template bool IsConstantExpr(
+ const Expr<SomeInteger> &, const FoldingContext *);
+extern template bool IsConstantExpr(
+ const Expr<SubscriptInteger> &, const FoldingContext *);
+extern template bool IsConstantExpr(
+ const StructureConstructor &, const FoldingContext *);
// Predicate: true when an expression is a constant expression (in the
// strict sense of the Fortran standard) or a dummy argument with
// INTENT(IN) and no VALUE. This is useful for representing explicit
// shapes of other dummy arguments.
-template <typename A> bool IsScopeInvariantExpr(const A &);
-extern template bool IsScopeInvariantExpr(const Expr<SomeType> &);
-extern template bool IsScopeInvariantExpr(const Expr<SomeInteger> &);
-extern template bool IsScopeInvariantExpr(const Expr<SubscriptInteger> &);
+template <typename A>
+bool IsScopeInvariantExpr(const A &, const FoldingContext * = nullptr);
+extern template bool IsScopeInvariantExpr(
+ const Expr<SomeType> &, const FoldingContext *);
+extern template bool IsScopeInvariantExpr(
+ const Expr<SomeInteger> &, const FoldingContext *);
+extern template bool IsScopeInvariantExpr(
+ const Expr<SubscriptInteger> &, const FoldingContext *);
// Predicate: true when an expression actually is a typed Constant<T>,
// perhaps with parentheses and wrapping around it. False for all typeless
@@ -57,8 +71,8 @@ extern template bool IsActuallyConstant(
// constant addressing and no vector-valued subscript.
// If a non-null ContextualMessages pointer is passed, an error message
// will be generated if and only if the result of the function is false.
-bool IsInitialDataTarget(
- const Expr<SomeType> &, parser::ContextualMessages * = nullptr);
+bool IsInitialDataTarget(const Expr<SomeType> &,
+ parser::ContextualMessages * = nullptr, const FoldingContext * = nullptr);
bool IsInitialProcedureTarget(const Symbol &);
bool IsInitialProcedureTarget(const ProcedureDesignator &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index f7636ecacfb78..9e63f216693a2 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -34,7 +34,8 @@ class IsConstantExprHelper
: public AllTraverse<IsConstantExprHelper<INVARIANT>, true> {
public:
using Base = AllTraverse<IsConstantExprHelper, true>;
- IsConstantExprHelper() : Base{*this} {}
+ explicit IsConstantExprHelper(const FoldingContext *c)
+ : Base{*this}, context_{c} {}
using Base::operator();
// A missing expression is not considered to be constant.
@@ -91,10 +92,33 @@ class IsConstantExprHelper
!sym.attrs().test(semantics::Attr::VALUE)));
}
+ bool operator()(const ImpliedDoIndex &ido) const {
+ return acImpliedDos_.find(ido.name) != acImpliedDos_.end() || !context_ ||
+ context_->GetImpliedDo(ido.name).has_value();
+ }
+ template <typename T> bool operator()(const ImpliedDo<T> &ido) {
+ if (!(*this)(ido.lower()) || !(*this)(ido.upper()) ||
+ !(*this)(ido.stride())) {
+ return false;
+ }
+ bool deleteAfter{acImpliedDos_.insert(ido.name()).second};
+ bool result{true};
+ for (const auto &vals : ido.values()) {
+ result &= (*this)(vals);
+ }
+ if (deleteAfter) {
+ acImpliedDos_.erase(ido.name());
+ }
+ return result;
+ }
+
private:
bool IsConstantStructureConstructorComponent(
const Symbol &, const Expr<SomeType> &) const;
bool IsConstantExprShape(const Shape &) const;
+
+ std::set<parser::CharBlock> acImpliedDos_;
+ const FoldingContext *context_{nullptr};
};
template <bool INVARIANT>
@@ -103,7 +127,8 @@ bool IsConstantExprHelper<INVARIANT>::IsConstantStructureConstructorComponent(
if (IsAllocatable(component)) {
return IsNullObjectPointer(&expr);
} else if (IsPointer(component)) {
- return IsNullPointerOrAllocatable(&expr) || IsInitialDataTarget(expr) ||
+ return IsNullPointerOrAllocatable(&expr) ||
+ IsInitialDataTarget(expr, /*messages=*/nullptr, context_) ||
IsInitialProcedureTarget(expr);
} else {
return (*this)(expr);
@@ -175,21 +200,27 @@ bool IsConstantExprHelper<INVARIANT>::IsConstantExprShape(
return true;
}
-template <typename A> bool IsConstantExpr(const A &x) {
- return IsConstantExprHelper<false>{}(x);
+template <typename A> bool IsConstantExpr(const A &x, const FoldingContext *c) {
+ return IsConstantExprHelper<false>{c}(x);
}
-template bool IsConstantExpr(const Expr<SomeType> &);
-template bool IsConstantExpr(const Expr<SomeInteger> &);
-template bool IsConstantExpr(const Expr<SubscriptInteger> &);
-template bool IsConstantExpr(const StructureConstructor &);
+template bool IsConstantExpr(const Expr<SomeType> &, const FoldingContext *);
+template bool IsConstantExpr(const Expr<SomeInteger> &, const FoldingContext *);
+template bool IsConstantExpr(
+ const Expr<SubscriptInteger> &, const FoldingContext *);
+template bool IsConstantExpr(
+ const StructureConstructor &, const FoldingContext *);
// IsScopeInvariantExpr()
-template <typename A> bool IsScopeInvariantExpr(const A &x) {
- return IsConstantExprHelper<true>{}(x);
+template <typename A>
+bool IsScopeInvariantExpr(const A &x, const FoldingContext *c) {
+ return IsConstantExprHelper<true>{c}(x);
}
-template bool IsScopeInvariantExpr(const Expr<SomeType> &);
-template bool IsScopeInvariantExpr(const Expr<SomeInteger> &);
-template bool IsScopeInvariantExpr(const Expr<SubscriptInteger> &);
+template bool IsScopeInvariantExpr(
+ const Expr<SomeType> &, const FoldingContext *);
+template bool IsScopeInvariantExpr(
+ const Expr<SomeInteger> &, const FoldingContext *);
+template bool IsScopeInvariantExpr(
+ const Expr<SubscriptInteger> &, const FoldingContext *);
// IsActuallyConstant()
struct IsActuallyConstantHelper {
@@ -207,13 +238,16 @@ struct IsActuallyConstantHelper {
bool operator()(const StructureConstructor &x) {
for (const auto &pair : x) {
const Expr<SomeType> &y{pair.second.value()};
- const auto sym{pair.first};
- const bool compIsConstant{(*this)(y)};
// If an allocatable component is initialized by a constant,
// the structure constructor is not a constant.
- if ((!compIsConstant && !IsNullPointerOrAllocatable(&y)) ||
- (compIsConstant && IsAllocatable(sym))) {
- return false;
+ if ((*this)(y)) {
+ if (IsAllocatable(pair.first)) {
+ return false;
+ }
+ } else {
+ if (!IsNullPointerOrAllocatable(&y)) {
+ return false;
+ }
}
}
return true;
@@ -241,8 +275,9 @@ class IsInitialDataTargetHelper
public:
using Base = AllTraverse<IsInitialDataTargetHelper, true>;
using Base::operator();
- explicit IsInitialDataTargetHelper(parser::ContextualMessages *m)
- : Base{*this}, messages_{m} {}
+ explicit IsInitialDataTargetHelper(
+ parser::ContextualMessages *m, const FoldingContext *c)
+ : Base{*this}, messages_{m}, context_{c} {}
bool emittedMessage() const { return emittedMessage_; }
@@ -292,15 +327,16 @@ class IsInitialDataTargetHelper
bool operator()(const StaticDataObject &) const { return false; }
bool operator()(const TypeParamInquiry &) const { return false; }
bool operator()(const Triplet &x) const {
- return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) &&
- IsConstantExpr(x.stride());
+ return IsConstantExpr(x.lower(), context_) &&
+ IsConstantExpr(x.upper(), context_) &&
+ IsConstantExpr(x.stride(), context_);
}
bool operator()(const Subscript &x) const {
return common::visit(common::visitors{
[&](const Triplet &t) { return (*this)(t); },
[&](const auto &y) {
return y.value().Rank() == 0 &&
- IsConstantExpr(y.value());
+ IsConstantExpr(y.value(), context_);
},
},
x.u);
@@ -310,8 +346,8 @@ class IsInitialDataTargetHelper
return CheckVarOrComponent(x.GetLastSymbol()) && (*this)(x.base());
}
bool operator()(const Substring &x) const {
- return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) &&
- (*this)(x.parent());
+ return IsConstantExpr(x.lower(), context_) &&
+ IsConstantExpr(x.upper(), context_) && (*this)(x.parent());
}
bool operator()(const DescriptorInquiry &) const { return false; }
template <typename T> bool operator()(const ArrayConstructor<T> &) const {
@@ -358,13 +394,14 @@ class IsInitialDataTargetHelper
return false;
}
- parser::ContextualMessages *messages_;
+ parser::ContextualMessages *messages_{nullptr};
+ const FoldingContext *context_{nullptr};
bool emittedMessage_{false};
};
-bool IsInitialDataTarget(
- const Expr<SomeType> &x, parser::ContextualMessages *messages) {
- IsInitialDataTargetHelper helper{messages};
+bool IsInitialDataTarget(const Expr<SomeType> &x,
+ parser::ContextualMessages *messages, const FoldingContext *context) {
+ IsInitialDataTargetHelper helper{messages, context};
bool result{helper(x)};
if (!result && messages && !helper.emittedMessage()) {
messages->Say(
@@ -732,7 +769,7 @@ class CheckSpecificationExprHelper
x.base().GetFirstSymbol(), x.base().GetLastSymbol(), x.field())) {
auto restorer{common::ScopedSet(inInquiry_, true)};
return (*this)(x.base());
- } else if (IsConstantExpr(x)) {
+ } else if (IsConstantExpr(x, &context_)) {
return std::nullopt;
} else {
return "non-constant descriptor inquiry not allowed for local object";
@@ -741,7 +778,7 @@ class CheckSpecificationExprHelper
Result operator()(const TypeParamInquiry &inq) const {
if (scope_.IsDerivedType()) {
- if (!IsConstantExpr(inq) &&
+ if (!IsConstantExpr(inq, &context_) &&
inq.base() /* X%T, not local T */) { // C750, C754
return "non-constant reference to a type parameter inquiry not allowed "
"for derived type components or type parameter values";
@@ -750,7 +787,7 @@ class CheckSpecificationExprHelper
IsInquiryAlwaysPermissible(inq.base()->GetFirstSymbol())) {
auto restorer{common::ScopedSet(inInquiry_, true)};
return (*this)(inq.base());
- } else if (!IsConstantExpr(inq)) {
+ } else if (!IsConstantExpr(inq, &context_)) {
return "non-constant type parameter inquiry not allowed for local object";
}
return std::nullopt;
@@ -802,7 +839,7 @@ class CheckSpecificationExprHelper
"' not allowed for derived type components or type parameter"
" values";
}
- if (inInquiry && !IsConstantExpr(x)) {
+ if (inInquiry && !IsConstantExpr(x, &context_)) {
return "non-constant reference to inquiry intrinsic '"s +
intrin.name +
"' not allowed for derived type components or type"
@@ -814,7 +851,7 @@ class CheckSpecificationExprHelper
// DescriptorInquiry operations (LBOUND) are checked elsewhere. If a
// call that makes it to here satisfies the requirements of a constant
// expression (as Fortran defines it), it's fine.
- if (IsConstantExpr(x)) {
+ if (IsConstantExpr(x, &context_)) {
return std::nullopt;
}
if (intrin.name == "present") {
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 52ea627d0bbe4..529e3a9ad5a08 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1295,8 +1295,6 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
return Expr<T>{std::move(funcRef)};
}
-Expr<ImpliedDoIndex::Result> FoldOperation(FoldingContext &, ImpliedDoIndex &&);
-
// Array constructor folding
template <typename T> class ArrayConstructorFolder {
public:
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 3628497531ef1..9f2bb94a9213f 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1187,7 +1187,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](auto &kx) {
if (auto len{kx.LEN()}) {
- if (IsScopeInvariantExpr(*len)) {
+ if (IsScopeInvariantExpr(*len, &context)) {
return Fold(context, ConvertToType<T>(*std::move(len)));
} else {
return Expr<T>{std::move(funcRef)};
@@ -1509,7 +1509,7 @@ Expr<TypeParamInquiry::Result> FoldOperation(
paramValue{
declType->derivedTypeSpec().FindParameter(parameterName)}) {
const semantics::MaybeIntExpr ¶mExpr{paramValue->GetExplicit()};
- if (paramExpr && IsConstantExpr(*paramExpr)) {
+ if (paramExpr && IsConstantExpr(*paramExpr, &context)) {
Expr<SomeInteger> intExpr{*paramExpr};
return Fold(context,
ConvertToType<TypeParamInquiry::Result>(std::move(intExpr)));
@@ -1530,7 +1530,7 @@ Expr<TypeParamInquiry::Result> FoldOperation(
if (details) {
isLen = details->attr() == common::TypeParamAttr::Len;
const semantics::MaybeIntExpr &initExpr{details->init()};
- if (initExpr && IsConstantExpr(*initExpr) &&
+ if (initExpr && IsConstantExpr(*initExpr, &context) &&
(!isLen || ToInt64(*initExpr))) {
Expr<SomeInteger> expr{*initExpr};
return Fold(context,
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index 3c4f3ecc61996..a2f6bc0f2ae51 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -80,7 +80,7 @@ Expr<SomeDerived> FoldOperation(
} else if (IsProcedure(symbol)) {
isConstant &= IsInitialProcedureTarget(expr);
} else {
- isConstant &= IsInitialDataTarget(expr);
+ isConstant &= IsInitialDataTarget(expr, /*messages=*/nullptr, &context);
}
} else if (IsAllocatable(symbol)) {
// F2023: 10.1.12 (3)(a)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index ac662ff70358b..6bab713136a0e 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2564,7 +2564,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
}
}
if (context.analyzingPDTComponentKindSelector() && expr &&
- IsConstantExpr(*expr)) {
+ IsConstantExpr(*expr, &context)) {
// Don't emit an error about a KIND= actual argument value when
// processing a kind selector in a PDT component declaration before
// it is instantianted, so long as it's a constant expression.
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 07bff1034f288..27913c3559c71 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -268,7 +268,7 @@ class GetLowerBoundHelper
semantics::IsAssumedSizeArray(symbol)) {
// last dimension of assumed-size dummy array: don't worry
// about handling an empty dimension
- ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound);
+ ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound, context_);
} else if (lbValue.value_or(0) == 1) {
// Lower bound is 1, regardless of extent
ok = true;
@@ -651,7 +651,7 @@ static MaybeExtentExpr GetExplicitUBOUND(FoldingContext *context,
const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
const auto &ubound{shapeSpec.ubound().GetExplicit()};
if (ubound && ubound->Rank() == 0 &&
- (!invariantOnly || IsScopeInvariantExpr(*ubound))) {
+ (!invariantOnly || IsScopeInvariantExpr(*ubound, context))) {
if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
if (auto cstExtent{ToInt64(
context ? Fold(*context, std::move(*extent)) : *extent)}) {
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index adbcc3776b763..9dbbc163d85b3 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -185,7 +185,8 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
}
bool CheckSubscriptExpr(
const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
- if (!evaluate::IsConstantExpr(expr)) { // C875,C881
+ if (!evaluate::IsConstantExpr(expr, /*context=*/
+ nullptr /* to accept unbound implied DO indices */)) { // C875,C881
context_.Say(
source_, "Data object must have constant subscripts"_err_en_US);
return false;
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 725188c623868..dd2cebfe47eff 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1731,7 +1731,9 @@ class ArrayConstructorContext {
if (type_) {
auto len{type_->LEN()};
if (explicitType_ ||
- (len && IsConstantExpr(*len) && !ContainsAnyImpliedDoIndex(*len))) {
+ (len &&
+ IsConstantExpr(
+ *len, &exprAnalyzer_.context().foldingContext()))) {
return len;
}
}
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 5508ba8378949..c1c0b28789cab 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -614,8 +614,8 @@ bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
bool CheckInitialDataPointerTarget(SemanticsContext &context,
const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
- return evaluate::IsInitialDataTarget(
- init, &context.foldingContext().messages()) &&
+ return evaluate::IsInitialDataTarget(init,
+ &context.foldingContext().messages(), &context.foldingContext()) &&
CheckPointerAssignment(context, pointer, init, scope,
/*isBoundsRemapping=*/false,
/*isAssumedRank=*/false);
diff --git a/flang/test/Semantics/ac-impl-do-data-ptr.f90 b/flang/test/Semantics/ac-impl-do-data-ptr.f90
new file mode 100644
index 0000000000000..4886ee3784985
--- /dev/null
+++ b/flang/test/Semantics/ac-impl-do-data-ptr.f90
@@ -0,0 +1,9 @@
+!RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+type child
+ integer, pointer :: id
+end type
+integer, parameter :: n = 5
+integer, save, target :: t1(n)
+type(child) :: t2(n) = [(child(t1(i)), i=1,n)]
+!CHECK: TYPE(child) :: t2(5_4) = [child::child(id=t1(1_8)),child(id=t1(2_8)),child(id=t1(3_8)),child(id=t1(4_8)),child(id=t1(5_8))]
+end
More information about the flang-commits
mailing list