[flang][OpenMP] Parse WHEN, OTHERWISE, MATCH clauses plus METADIRECTIVE

Parse METADIRECTIVE as a standalone executable directive at the moment.
This will allow testing the parser code.

There is no lowering, not even clause conversion yet. There is also no
verification of the allowed values for trait sets, trait properties.

Author: kparzysz

flang/include/flang/Parser/dump-parse-tree.h

@@ -476,6 +476,12 @@ class ParseTreeDumper {
   NODE(parser, NullInit)
   NODE(parser, ObjectDecl)
   NODE(parser, OldParameterStmt)
+  NODE(parser, OmpMetadirectiveDirective)
+  NODE(parser, OmpMatchClause)
+  NODE(parser, OmpOtherwiseClause)
+  NODE(parser, OmpWhenClause)
+  NODE(OmpWhenClause, Modifier)
+  NODE(parser, OmpDirectiveSpecification)
   NODE(parser, OmpTraitPropertyName)
   NODE(parser, OmpTraitScore)
   NODE(parser, OmpTraitPropertyExtension)

flang/include/flang/Parser/parse-tree.h

@@ -3456,6 +3456,14 @@ WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
 struct OmpClause;
 struct OmpClauseList;
 
+struct OmpDirectiveSpecification {
+  TUPLE_CLASS_BOILERPLATE(OmpDirectiveSpecification);
+  std::tuple<llvm::omp::Directive,
+      std::optional<common::Indirection<OmpClauseList>>>
+      t;
+  CharBlock source;
+};
+
 // 2.1 Directives or clauses may accept a list or extended-list.
 //     A list item is a variable, array section or common block name (enclosed
 //     in slashes). An extended list item is a list item or a procedure Name.
@@ -3964,6 +3972,7 @@ struct OmpBindClause {
 // data-sharing-attribute ->
 //    SHARED | NONE |                               // since 4.5
 //    PRIVATE | FIRSTPRIVATE                        // since 5.0
+// See also otherwise-clause.
 struct OmpDefaultClause {
   ENUM_CLASS(DataSharingAttribute, Private, Firstprivate, Shared, None)
   WRAPPER_CLASS_BOILERPLATE(OmpDefaultClause, DataSharingAttribute);
@@ -4184,6 +4193,16 @@ struct OmpMapClause {
   std::tuple<MODIFIERS(), OmpObjectList, /*CommaSeparated=*/bool> t;
 };
 
+// Ref: [5.0:58-60], [5.1:63-68], [5.2:194-195]
+//
+// match-clause ->
+//    MATCH (context-selector-specification)        // since 5.0
+struct OmpMatchClause {
+  // The context-selector is an argument.
+  WRAPPER_CLASS_BOILERPLATE(
+      OmpMatchClause, traits::OmpContextSelectorSpecification);
+};
+
 // Ref: [5.2:217-218]
 // message-clause ->
 //    MESSAGE("message-text")
@@ -4214,6 +4233,17 @@ struct OmpOrderClause {
   std::tuple<MODIFIERS(), Ordering> t;
 };
 
+// Ref: [5.0:56-57], [5.1:60-62], [5.2:191]
+//
+// otherwise-clause ->
+//    DEFAULT ([directive-specification])           // since 5.0, until 5.1
+// otherwise-clause ->
+//    OTHERWISE ([directive-specification])]        // since 5.2
+struct OmpOtherwiseClause {
+  WRAPPER_CLASS_BOILERPLATE(
+      OmpOtherwiseClause, std::optional<OmpDirectiveSpecification>);
+};
+
 // Ref: [4.5:46-50], [5.0:74-78], [5.1:92-96], [5.2:229-230]
 //
 // proc-bind-clause ->
@@ -4299,6 +4329,17 @@ struct OmpUpdateClause {
   std::variant<OmpDependenceType, OmpTaskDependenceType> u;
 };
 
+// Ref: [5.0:56-57], [5.1:60-62], [5.2:190-191]
+//
+// when-clause ->
+//    WHEN (context-selector :
+//        [directive-specification])                // since 5.0
+struct OmpWhenClause {
+  TUPLE_CLASS_BOILERPLATE(OmpWhenClause);
+  MODIFIER_BOILERPLATE(OmpContextSelector);
+  std::tuple<MODIFIERS(), std::optional<OmpDirectiveSpecification>> t;
+};
+
 // OpenMP Clauses
 struct OmpClause {
   UNION_CLASS_BOILERPLATE(OmpClause);
@@ -4323,6 +4364,12 @@ struct OmpClauseList {
 
 // --- Directives and constructs
 
+struct OmpMetadirectiveDirective {
+  TUPLE_CLASS_BOILERPLATE(OmpMetadirectiveDirective);
+  std::tuple<OmpClauseList> t;
+  CharBlock source;
+};
+
 // Ref: [5.1:89-90], [5.2:216]
 //
 // nothing-directive ->
@@ -4696,7 +4743,7 @@ struct OpenMPStandaloneConstruct {
   CharBlock source;
   std::variant<OpenMPSimpleStandaloneConstruct, OpenMPFlushConstruct,
       OpenMPCancelConstruct, OpenMPCancellationPointConstruct,
-      OpenMPDepobjConstruct>
+      OpenMPDepobjConstruct, OmpMetadirectiveDirective>
       u;
 };
 

flang/lib/Lower/OpenMP/Clauses.cpp

@@ -230,9 +230,9 @@ MAKE_EMPTY_CLASS(Threadprivate, Threadprivate);
 
 MAKE_INCOMPLETE_CLASS(AdjustArgs, AdjustArgs);
 MAKE_INCOMPLETE_CLASS(AppendArgs, AppendArgs);
-MAKE_INCOMPLETE_CLASS(Match, Match);
+// MAKE_INCOMPLETE_CLASS(Match, Match);
 // MAKE_INCOMPLETE_CLASS(Otherwise, );   // missing-in-parser
-MAKE_INCOMPLETE_CLASS(When, When);
+// MAKE_INCOMPLETE_CLASS(When, When);
 
 List<IteratorSpecifier>
 makeIteratorSpecifiers(const parser::OmpIteratorSpecifier &inp,
@@ -997,7 +997,11 @@ Map make(const parser::OmpClause::Map &inp,
               /*LocatorList=*/makeObjects(t4, semaCtx)}};
 }
 
-// Match: incomplete
+Match make(const parser::OmpClause::Match &inp,
+           semantics::SemanticsContext &semaCtx) {
+  return Match{};
+}
+
 // MemoryOrder: empty
 // Mergeable: empty
 
@@ -1102,6 +1106,10 @@ Ordered make(const parser::OmpClause::Ordered &inp,
 }
 
 // Otherwise: incomplete, missing-in-parser
+Otherwise make(const parser::OmpClause::Otherwise &inp,
+               semantics::SemanticsContext &semaCtx) {
+  return Otherwise{};
+}
 
 Partial make(const parser::OmpClause::Partial &inp,
              semantics::SemanticsContext &semaCtx) {
@@ -1356,7 +1364,12 @@ UsesAllocators make(const parser::OmpClause::UsesAllocators &inp,
 }
 
 // Weak: empty
-// When: incomplete
+
+When make(const parser::OmpClause::When &inp,
+          semantics::SemanticsContext &semaCtx) {
+  return When{};
+}
+
 // Write: empty
 } // namespace clause
 

flang/lib/Lower/OpenMP/Clauses.h

@@ -257,6 +257,7 @@ using OmpxBare = tomp::clause::OmpxBareT<TypeTy, IdTy, ExprTy>;
 using OmpxDynCgroupMem = tomp::clause::OmpxDynCgroupMemT<TypeTy, IdTy, ExprTy>;
 using Ordered = tomp::clause::OrderedT<TypeTy, IdTy, ExprTy>;
 using Order = tomp::clause::OrderT<TypeTy, IdTy, ExprTy>;
+using Otherwise = tomp::clause::OtherwiseT<TypeTy, IdTy, ExprTy>;
 using Partial = tomp::clause::PartialT<TypeTy, IdTy, ExprTy>;
 using Priority = tomp::clause::PriorityT<TypeTy, IdTy, ExprTy>;
 using Private = tomp::clause::PrivateT<TypeTy, IdTy, ExprTy>;

flang/lib/Lower/OpenMP/OpenMP.cpp

@@ -2809,6 +2809,11 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
   TODO(converter.getCurrentLocation(), "OpenMPDepobjConstruct");
 }
 
+static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
+                   semantics::SemanticsContext &semaCtx,
+                   lower::pft::Evaluation &eval,
+                   const parser::OmpMetadirectiveDirective &construct) {}
+
 static void
 genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
        semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,

flang/lib/Parser/openmp-parsers.cpp

@@ -153,6 +153,9 @@ static TypeDeclarationStmt makeIterSpecDecl(std::list<ObjectName> &&names) {
       makeEntityList(std::move(names)));
 }
 
+TYPE_PARSER(sourced(construct<OmpDirectiveSpecification>(
+    OmpDirectiveNameParser{}, maybe(indirect(Parser<OmpClauseList>{})))))
+
 // --- Parsers for context traits -------------------------------------
 
 static std::string nameToString(Name &&name) { return name.ToString(); }
@@ -496,6 +499,9 @@ TYPE_PARSER(sourced(construct<OmpToClause::Modifier>(
         construct<OmpToClause::Modifier>(Parser<OmpMapper>{}) ||
         construct<OmpToClause::Modifier>(Parser<OmpIterator>{})))))
 
+TYPE_PARSER(sourced(construct<OmpWhenClause::Modifier>( //
+    Parser<OmpContextSelector>{})))
+
 // --- Parsers for clauses --------------------------------------------
 
 /// `MOBClause` is a clause that has a
@@ -693,6 +699,16 @@ TYPE_PARSER(construct<OmpOrderClause>(
     maybe(nonemptyList(Parser<OmpOrderClause::Modifier>{}) / ":"),
     "CONCURRENT" >> pure(OmpOrderClause::Ordering::Concurrent)))
 
+TYPE_PARSER(construct<OmpMatchClause>(
+    Parser<traits::OmpContextSelectorSpecification>{}))
+
+TYPE_PARSER(construct<OmpOtherwiseClause>(
+    maybe(sourced(Parser<OmpDirectiveSpecification>{}))))
+
+TYPE_PARSER(construct<OmpWhenClause>(
+    maybe(nonemptyList(Parser<OmpWhenClause::Modifier>{}) / ":"),
+    maybe(sourced(Parser<OmpDirectiveSpecification>{}))))
+
 // OMP 5.2 12.6.1 grainsize([ prescriptiveness :] scalar-integer-expression)
 TYPE_PARSER(construct<OmpGrainsizeClause>(
     maybe(nonemptyList(Parser<OmpGrainsizeClause::Modifier>{}) / ":"),
@@ -810,6 +826,8 @@ TYPE_PARSER(
                   parenthesized(Parser<OmpObjectList>{}))) ||
     "MAP" >> construct<OmpClause>(construct<OmpClause::Map>(
                  parenthesized(Parser<OmpMapClause>{}))) ||
+    "MATCH" >> construct<OmpClause>(construct<OmpClause::Match>(
+                   parenthesized(Parser<OmpMatchClause>{}))) ||
     "MERGEABLE" >> construct<OmpClause>(construct<OmpClause::Mergeable>()) ||
     "MESSAGE" >> construct<OmpClause>(construct<OmpClause::Message>(
                      parenthesized(Parser<OmpMessageClause>{}))) ||
@@ -830,6 +848,8 @@ TYPE_PARSER(
                    parenthesized(Parser<OmpOrderClause>{}))) ||
     "ORDERED" >> construct<OmpClause>(construct<OmpClause::Ordered>(
                      maybe(parenthesized(scalarIntConstantExpr)))) ||
+    "OTHERWISE" >> construct<OmpClause>(construct<OmpClause::Otherwise>(
+                       maybe(parenthesized(Parser<OmpOtherwiseClause>{})))) ||
     "PARTIAL" >> construct<OmpClause>(construct<OmpClause::Partial>(
                      maybe(parenthesized(scalarIntConstantExpr)))) ||
     "PRIORITY" >> construct<OmpClause>(construct<OmpClause::Priority>(
@@ -885,7 +905,9 @@ TYPE_PARSER(
                      parenthesized(nonemptyList(name)))) ||
     "UNTIED" >> construct<OmpClause>(construct<OmpClause::Untied>()) ||
     "UPDATE" >> construct<OmpClause>(construct<OmpClause::Update>(
-                    parenthesized(Parser<OmpUpdateClause>{}))))
+                    parenthesized(Parser<OmpUpdateClause>{}))) ||
+    "WHEN" >> construct<OmpClause>(construct<OmpClause::When>(
+                  parenthesized(Parser<OmpWhenClause>{}))))
 
 // [Clause, [Clause], ...]
 TYPE_PARSER(sourced(construct<OmpClauseList>(
@@ -905,6 +927,9 @@ TYPE_PARSER(sourced(construct<OpenMPUtilityConstruct>(
     sourced(construct<OpenMPUtilityConstruct>(
         sourced(Parser<OmpNothingDirective>{}))))))
 
+TYPE_PARSER(sourced(construct<OmpMetadirectiveDirective>(
+    "METADIRECTIVE" >> Parser<OmpClauseList>{})))
+
 // Omp directives enclosing do loop
 TYPE_PARSER(sourced(construct<OmpLoopDirective>(first(
     "DISTRIBUTE PARALLEL DO SIMD" >>
@@ -1050,6 +1075,8 @@ TYPE_PARSER(
         construct<OpenMPStandaloneConstruct>(Parser<OpenMPCancelConstruct>{}) ||
         construct<OpenMPStandaloneConstruct>(
             Parser<OpenMPCancellationPointConstruct>{}) ||
+        construct<OpenMPStandaloneConstruct>(
+            Parser<OmpMetadirectiveDirective>{}) ||
         construct<OpenMPStandaloneConstruct>(Parser<OpenMPDepobjConstruct>{})) /
     endOfLine)
 

flang/lib/Parser/unparse.cpp

@@ -2070,6 +2070,10 @@ class UnparseVisitor {
   void Unparse(const llvm::omp::Directive &x) {
     Word(llvm::omp::getOpenMPDirectiveName(x).str());
   }
+  void Unparse(const OmpDirectiveSpecification &x) {
+    Walk(std::get<llvm::omp::Directive>(x.t));
+    Walk(std::get<std::optional<common::Indirection<OmpClauseList>>>(x.t));
+  }
   void Unparse(const OmpTraitScore &x) {
     Word("SCORE(");
     Walk(x.v);
@@ -2291,6 +2295,11 @@ class UnparseVisitor {
     Walk(std::get<std::optional<std::list<Modifier>>>(x.t), ": ");
     Walk(std::get<OmpObjectList>(x.t));
   }
+  void Unparse(const OmpWhenClause &x) {
+    using Modifier = OmpWhenClause::Modifier;
+    Walk(std::get<std::optional<std::list<Modifier>>>(x.t), ": ");
+    Walk(std::get<std::optional<OmpDirectiveSpecification>>(x.t));
+  }
 #define GEN_FLANG_CLAUSE_UNPARSE
 #include "llvm/Frontend/OpenMP/OMP.inc"
   void Unparse(const OmpLoopDirective &x) {
@@ -2800,6 +2809,13 @@ class UnparseVisitor {
                   },
         x.u);
   }
+  void Unparse(const OmpMetadirectiveDirective &x) {
+    BeginOpenMP();
+    Word("!$OMP METADIRECTIVE ");
+    Walk(std::get<OmpClauseList>(x.t));
+    Put("\n");
+    EndOpenMP();
+  }
   void Unparse(const OpenMPDepobjConstruct &x) {
     BeginOpenMP();
     Word("!$OMP DEPOBJ");

flang/lib/Semantics/check-omp-structure.cpp

@@ -214,6 +214,11 @@ class AssociatedLoopChecker {
 };
 
 bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
+  // Do not do clause checks while processing METADIRECTIVE.
+  if (GetDirectiveNest(ContextSelectorNest) > 0) {
+    return true;
+  }
+
   unsigned version{context_.langOptions().OpenMPVersion};
   DirectiveContext &dirCtx = GetContext();
   llvm::omp::Directive dir{dirCtx.directive};
@@ -590,6 +595,22 @@ void OmpStructureChecker::CheckHintClause(
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
+  PushContextAndClauseSets(x.source, std::get<llvm::omp::Directive>(x.t));
+}
+
+void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {
+  dirContext_.pop_back();
+}
+
+void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
+  PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_metadirective);
+}
+
+void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
+  dirContext_.pop_back();
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
   // Simd Construct with Ordered Construct Nesting check
   // We cannot use CurrentDirectiveIsNested() here because
@@ -2894,6 +2915,7 @@ CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
 CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
 CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
+CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise)
 CHECK_SIMPLE_CLAUSE(When, OMPC_when)
 CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)
 CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)
@@ -4441,6 +4463,14 @@ void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctxSel) {
+  EnterDirectiveNest(ContextSelectorNest);
+}
+
+void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
+  ExitDirectiveNest(ContextSelectorNest);
+}
+
 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
   return llvm::omp::getOpenMPClauseName(clause);
 }

flang/lib/Semantics/check-omp-structure.h

@@ -144,6 +144,15 @@ class OmpStructureChecker
   void Enter(const parser::DoConstruct &);
   void Leave(const parser::DoConstruct &);
 
+  void Enter(const parser::OmpDirectiveSpecification &);
+  void Leave(const parser::OmpDirectiveSpecification &);
+
+  void Enter(const parser::OmpMetadirectiveDirective &);
+  void Leave(const parser::OmpMetadirectiveDirective &);
+
+  void Enter(const parser::OmpContextSelector &);
+  void Leave(const parser::OmpContextSelector &);
+
 #define GEN_FLANG_CLAUSE_CHECK_ENTER
 #include "llvm/Frontend/OpenMP/OMP.inc"
 
@@ -280,7 +289,8 @@ class OmpStructureChecker
     TargetBlockOnlyTeams,
     TargetNest,
     DeclarativeNest,
-    LastType = DeclarativeNest,
+    ContextSelectorNest,
+    LastType = ContextSelectorNest,
   };
   int directiveNest_[LastType + 1] = {0};