[flang] Add -pedantic check for passing non-VOLATILE array section to VOLATILE dummy arg

Add the check, which partially addresses #137369

Implement HasTriplet().

Author: eugeneepshteyn

flang/include/flang/Evaluate/tools.h

@@ -1123,6 +1123,9 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
 // Predicate: does a variable contain a vector-valued subscript (not a triplet)?
 bool HasVectorSubscript(const Expr<SomeType> &);
 
+// Predicate: does a variable contain a triplet?
+bool HasTriplet(const Expr<SomeType> &);
+
 // Predicate: does an expression contain constant?
 bool HasConstant(const Expr<SomeType> &);
 

flang/lib/Evaluate/tools.cpp

@@ -1173,6 +1173,25 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
   return HasVectorSubscriptHelper{}(expr);
 }
 
+// HasTriplet()
+struct HasTripletHelper
+    : public AnyTraverse<HasTripletHelper, bool,
+          /*TraverseAssocEntityDetails=*/false> {
+  using Base = AnyTraverse<HasTripletHelper, bool, false>;
+  HasTripletHelper() : Base{*this} {}
+  using Base::operator();
+  bool operator()(const Subscript &ss) const {
+    return std::holds_alternative<Triplet>(ss.u);
+  }
+  bool operator()(const ProcedureRef &) const {
+    return false; // don't descend into function call arguments
+  }
+};
+
+bool HasTriplet(const Expr<SomeType> &expr) {
+  return HasTripletHelper{}(expr);
+}
+
 // HasConstant()
 struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
                                /*TraverseAssocEntityDetails=*/false> {

flang/lib/Semantics/definable.cpp

@@ -371,6 +371,9 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
         return parser::Message{at,
             "Variable '%s' has a vector subscript"_err_en_US, expr.AsFortran()};
       }
+    } else if (evaluate::HasTriplet(expr)) {
+      return parser::Message{at,
+          "Variable '%s' has array section"_err_en_US, expr.AsFortran()};
     }
     if (FindPureProcedureContaining(scope) &&
         evaluate::ExtractCoarrayRef(expr)) {