[flang] checkpoint

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

flang/lib/evaluate/descender.h

@@ -19,6 +19,7 @@
 
 #include "expression.h"
 #include "../semantics/type.h"
+#include <algorithm>
 
 namespace Fortran::evaluate {
 
@@ -363,5 +364,41 @@ private:
 
   VISITOR &visitor_;
 };
+
+template<typename DERIVED, bool DEFAULT = true, bool ALL = true>
+class ExpressionPredicateHelperBase {
+protected:
+  template<typename A, bool C> bool operator()(const common::Indirection<A,C> &x) {
+    return derived()(x.value());
+  }
+  template<typename A> bool operator()(const A *x) {
+    if (x != nullptr) {
+      return derived()(*x);
+    } else {
+      return DEFAULT;
+    }
+  }
+  template<typename A> bool operator()(const std::optional<A> &x) {
+    if (x.has_value()) {
+      return derived()(*x);
+    } else {
+      return DEFAULT;
+    }
+  }
+  template<typename... A> bool operator()(const std::variant<A...> &u) {
+    return std::visit(derived(), u);
+  }
+  template<typename A> bool operator()(const std::vector<A> &x) {
+    if constexpr (ALL) {
+      return std::all_of(x.begin(), x.end(), derived());
+    } else {
+      return std::any_of(x.begin(), x.end(), derived());
+    }
+  }
+private:
+  DERIVED &derived() { return *static_cast<DERIVED *>(this); }
+  const DERIVED &derived() const { return *static_cast<const DERIVED *>(this); }
+};
+
 }
 #endif  // FORTRAN_EVALUATE_DESCENDER_H_

flang/lib/evaluate/fold.cc

@@ -17,6 +17,7 @@
 #include "characteristics.h"
 #include "common.h"
 #include "constant.h"
+#include "descender.h"
 #include "expression.h"
 #include "host.h"
 #include "int-power.h"
@@ -32,6 +33,7 @@
 #include "../semantics/scope.h"
 #include "../semantics/symbol.h"
 #include "../semantics/tools.h"
+#include <algorithm>
 #include <cmath>
 #include <complex>
 #include <cstdio>
@@ -2539,6 +2541,115 @@ bool IsConstantExpr(const Expr<SomeType> &expr) {
   return Visitor<IsConstantExprVisitor>{0}.Traverse(expr);
 }
 
+// Specification expression validation (10.1.11(2), C1010)
+struct IsSpecificationExprHelper : public ExpressionPredicateHelperBase<IsSpecificationExprHelper, true, true> {
+  using Base = ExpressionPredicateHelperBase<IsSpecificationExprHelper, true, true>;
+  using Base::operator();
+
+  template<typename A> bool operator()(const A &) { return false; }
+
+  template<typename T> bool operator()(const Constant<T> &) { return true; }
+  bool operator()(const StaticDataObject::Pointer &) { return true; }
+
+  bool operator()(const semantics::Symbol &symbol) {
+    if (symbol.IsDummy()) {
+      return !symbol.attrs().test(semantics::Attr::OPTIONAL) &&
+             !symbol.attrs().test(semantics::Attr::INTENT_OUT);
+    } else if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+      // TODO: what about EQUIVALENCE with data in COMMON?
+      // TODO: does this work for blank COMMON?
+      return object->commonBlock() != nullptr;
+    } else if (symbol.has<semantics::UseDetails>() ||
+               symbol.has<semantics::HostAssocDetails>()) {
+      return true;
+    } else {
+      return false;
+    }
+  }
+  bool operator()(const Component &x) {
+    return (*this)(x.base());
+  }
+  bool operator()(const NamedEntity &x) {
+    if (const Component *component{x.UnwrapComponent()}) {
+      return (*this)(*component);
+    } else {
+      return (*this)(x.GetFirstSymbol());
+    }
+  }
+  bool operator()(const Triplet &x) {
+    return (*this)(x.lower()) && (*this)(x.upper()) && (*this)(x.stride());
+  }
+  bool operator()(const Subscript &x) {
+    return (*this)(x.u);
+  }
+  bool operator()(const ArrayRef &x) {
+    return (*this)(x.base()) && (*this)(x.subscript());
+  }
+  bool operator()(const DataRef &x) {
+    return (*this)(x.u);
+  }
+  bool operator()(const Substring &x) {
+    return (*this)(x.parent()) && (*this)(x.lower()) && (*this)(x.upper());
+  }
+  bool operator()(const ComplexPart &x) {
+    return (*this)(x.complex());
+  }
+  template<typename T> bool operator()(const Designator<T> &x) {
+    return (*this)(x.u);
+  }
+  template<typename T> bool operator()(const Variable<T> &x) {
+    return (*this)(x.u);
+  }
+
+  template<typename T> bool operator()(const ArrayConstructorValues<T> &x) {
+    return std::all_of(x.begin(), x.end(), *this);
+  }
+  template<typename T> bool operator()(const ArrayConstructorValue<T> &x) {
+    return (*this)(x.u);
+  }
+  template<typename T> bool operator()(const ImpliedDo<T> &x) {
+    return (*this)(x.lower) && (*this)(x.upper) && (*this)(x.stride) && (*this)(x.values());
+  }
+  bool operator()(const ImpliedDoIndex &) { return true; }
+  bool operator()(const StructureConstructor &x) {
+    return std::all_of(x.begin(), x.end(), *this);
+  }
+  bool operator()(const StructureConstructorValues::value_type &x) {
+    return (*this)(x.second);
+  }
+  template<int KIND> bool operator()(const TypeParamInquiry<KIND> &x) {
+    return (*this)(x.base());
+  }
+
+  bool operator()(const ActualArgument &x) {
+    if (const auto *symbol{x.GetAssumedTypeDummy()}) {
+      return (*this)(*symbol);
+    } else {
+      return (*this)(x.UnwrapExpr());
+    }
+  }
+  bool operator()(const ProcedureRef &x) {
+    // TODO: check the designator for intrinsic / PURE
+    return (*this)(x.arguments());
+  }
+
+  template<typename D, typename R, typename O>
+  bool operator()(const Operation<D,R,O> &op) {
+    return (*this)(op.left());
+  }
+  template<typename D, typename R, typename LO, typename RO>
+  bool operator()(const Operation<D,R,LO,RO> &op) {
+    return (*this)(op.left()) && (*this)(op.right());
+  }
+  template<typename T> bool operator()(const Expr<T> &x) {
+    return (*this)(x.u);
+  }
+};
+
+bool IsSpecificationExpr(const Expr<SomeType> &x) {
+  return IsSpecificationExprHelper{}(x);
+}
+
 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
   return std::visit(
       [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);

flang/lib/evaluate/fold.h

@@ -82,6 +82,11 @@ auto GetScalarConstantValue(const EXPR &expr) -> std::optional<Scalar<T>> {
 // constant value.
 bool IsConstantExpr(const Expr<SomeType> &);
 
+// Predicate: true when an expression is a specification expression
+// (10.1.11(2), C1010).  Constant expressions are always valid
+// specification expressions.
+bool IsSpecificationExpr(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> &);

flang/lib/evaluate/traversal.h

@@ -20,7 +20,7 @@
 
 // Implements an expression traversal utility framework.
 // See fold.cc to see an example of how this framework was used to
-// implement then detection of constant expressions.
+// implement detection of constant expressions.
 //
 // The bases of references (component, array, coarray, substring, &
 // procedures) are visited before any subscript, cosubscript, or actual