diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index 9b01fbde9e6c..db8595048780 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -2266,6 +2266,10 @@ private: } }; +template bool IsConstantExpr(const A &x) { + return Visitor{0}.Traverse(x); +} + bool IsConstantExpr(const Expr &expr) { return Visitor{0}.Traverse(expr); } @@ -2282,4 +2286,73 @@ std::optional ToInt64(const Expr &expr) { return std::nullopt; } } + +// Object pointer initialization checking predicate IsInitialDataTarget(). +// This code determines whether an expression is allowable as the static +// data address used to initialize a pointer with "=> x". See C765. +// The caller is responsible for checking the base object symbol's +// characteristics (TARGET, SAVE, &c.) since this code can't use GetUltimate(). +template bool IsInitialDataTarget(const A &) { return false; }; +template bool IsInitialDataTarget(const std::variant &); +bool IsInitialDataTarget(const DataRef &); +template bool IsInitialDataTarget(const Expr &); +bool IsInitialDataTarget(const semantics::Symbol *s) { return true; }; +bool IsInitialDataTarget(const Component &x) { + return IsInitialDataTarget(x.base()); +} +bool IsInitialDataTarget(const Triplet &x) { + if (auto lower{x.lower()}) { + if (!IsConstantExpr(*lower)) { + return false; + } + } + if (auto upper{x.upper()}) { + if (!IsConstantExpr(*upper)) { + return false; + } + } + return IsConstantExpr(x.stride()); +} +bool IsInitialDataTarget(const Subscript &x) { + return std::visit( + common::visitors{ + [](const Triplet &t) { return IsInitialDataTarget(t); }, + [&](const auto &y) { + return y.value().Rank() == 0 && IsConstantExpr(y.value()); + }, + }, + x.u); +} +bool IsInitialDataTarget(const ArrayRef &x) { + for (const Subscript &ss : x.subscript()) { + if (!IsInitialDataTarget(ss)) { + return false; + } + } + return IsInitialDataTarget(x.base()); +} +bool IsInitialDataTarget(const DataRef &x) { + return std::visit([](const auto &y) { return IsInitialDataTarget(y); }, x.u); +} +bool IsInitialDataTarget(const Substring &x) { + return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()); +}; +bool IsInitialDataTarget(const ComplexPart &x) { + return IsInitialDataTarget(x.complex()); +}; +template bool IsInitialDataTarget(const Designator &x) { + return IsInitialDataTarget(x.u); +} +bool IsInitialDataTarget(const NullPointer &) { return true; } +template bool IsInitialDataTarget(const Expr &x) { + return IsInitialDataTarget(x.u); +} +template bool IsInitialDataTarget(const std::variant &u) { + return std::visit([](const auto &x) { return IsInitialDataTarget(x); }, u); +} + +bool IsInitialDataTarget(const Expr &x) { + return IsInitialDataTarget(x.u); +} + } diff --git a/flang/lib/evaluate/fold.h b/flang/lib/evaluate/fold.h index 72dbe47f8db7..d6142d9a95b4 100644 --- a/flang/lib/evaluate/fold.h +++ b/flang/lib/evaluate/fold.h @@ -82,6 +82,10 @@ auto GetScalarConstantValue(const EXPR &expr) -> std::optional> { // constant value. bool IsConstantExpr(const Expr &); +// Predicate: true when an expression is an object designator with +// constant addressing and no vector-valued subscript. +bool IsInitialDataTarget(const Expr &); + // When an expression is a constant integer, ToInt64() extracts its value. // Ensure that the expression has been folded beforehand when folding might // be required.