[flang] IsInitialDataTarget()

Original-commit: flang-compiler/f18@c005e14de9
Reviewed-on: https://github.com/flang-compiler/f18/pull/531
Tree-same-pre-rewrite: false

flang/lib/evaluate/fold.cc

@@ -2266,6 +2266,10 @@ private:
   }
 };
 
+template<typename A> bool IsConstantExpr(const A &x) {
+  return Visitor<IsConstantExprVisitor>{0}.Traverse(x);
+}
+
 bool IsConstantExpr(const Expr<SomeType> &expr) {
   return Visitor<IsConstantExprVisitor>{0}.Traverse(expr);
 }
@@ -2282,4 +2286,73 @@ std::optional<std::int64_t> ToInt64(const Expr<SomeType> &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<typename A> bool IsInitialDataTarget(const A &) { return false; };
+template<typename... A> bool IsInitialDataTarget(const std::variant<A...> &);
+bool IsInitialDataTarget(const DataRef &);
+template<typename T> bool IsInitialDataTarget(const Expr<T> &);
+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<typename T> bool IsInitialDataTarget(const Designator<T> &x) {
+  return IsInitialDataTarget(x.u);
+}
+bool IsInitialDataTarget(const NullPointer &) { return true; }
+template<typename T> bool IsInitialDataTarget(const Expr<T> &x) {
+  return IsInitialDataTarget(x.u);
+}
+template<typename... A> bool IsInitialDataTarget(const std::variant<A...> &u) {
+  return std::visit([](const auto &x) { return IsInitialDataTarget(x); }, u);
+}
+
+bool IsInitialDataTarget(const Expr<SomeType> &x) {
+  return IsInitialDataTarget(x.u);
+}
+
 }

flang/lib/evaluate/fold.h

@@ -82,6 +82,10 @@ auto GetScalarConstantValue(const EXPR &expr) -> std::optional<Scalar<T>> {
 // constant value.
 bool IsConstantExpr(const Expr<SomeType> &);
 
+// Predicate: true when an expression is an object designator with
+// constant addressing and no vector-valued subscript.
+bool IsInitialDataTarget(const Expr<SomeType> &);
+
 // When an expression is a constant integer, ToInt64() extracts its value.
 // Ensure that the expression has been folded beforehand when folding might
 // be required.