[flang-commits] [flang] [llvm] [flang][OpenMP] Parse WHEN, OTHERWISE, MATCH clauses plus METADIRECTIVE (PR #121817)
Krzysztof Parzyszek via flang-commits
flang-commits at lists.llvm.org
Wed Jan 29 09:56:39 PST 2025
https://github.com/kparzysz updated https://github.com/llvm/llvm-project/pull/121817
>From 3bfe74e70673bb74cfed0a86ce66c8c37095352b Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Tue, 14 Jan 2025 05:39:43 -0600
Subject: [PATCH 1/7] [flang][OpenMP] Make parsing of trait properties more
context-sensitive
A trait poperty can be one of serveral alternatives, and each property
in a list was parsed as if it could be any of these alternatives
independently from other properties. This made the parsing vulnerable
to certain ambiguities in the trait grammar (provided in the OpenMP
spec).
At the same time the OpenMP spec gives the expected types of properties
for almost every trait: all properties listed for a given trait are
usually of the same type, e.g. names, clauses, etc.
Incorporate these restrictions into the parser, and additionally use
property extensions as the fallback if the parsing of the expected
property type failed. This is intended to allow the parser to succeed,
and instead let the semantic-checking code emit a more user-friendly
message.
---
flang/include/flang/Parser/dump-parse-tree.h | 2 +-
flang/include/flang/Parser/parse-tree.h | 40 ++----
flang/lib/Parser/openmp-parsers.cpp | 125 +++++++++++++++----
flang/lib/Parser/unparse.cpp | 5 +-
4 files changed, 116 insertions(+), 56 deletions(-)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 11725991e9c9a9..49eeed0e7b4393 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -479,7 +479,7 @@ class ParseTreeDumper {
NODE(parser, OmpTraitPropertyName)
NODE(parser, OmpTraitScore)
NODE(parser, OmpTraitPropertyExtension)
- NODE(OmpTraitPropertyExtension, ExtensionValue)
+ NODE(OmpTraitPropertyExtension, Complex)
NODE(parser, OmpTraitProperty)
NODE(parser, OmpTraitSelectorName)
NODE_ENUM(OmpTraitSelectorName, Value)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 00d85aa05fb3a5..f8175ea1de679e 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3505,37 +3505,22 @@ struct OmpTraitScore {
};
// trait-property-extension ->
-// trait-property-name (trait-property-value, ...)
-// trait-property-value ->
// trait-property-name |
-// scalar-integer-expression |
-// trait-property-extension
-//
-// The grammar in OpenMP 5.2+ spec is ambiguous, the above is a different
-// version (but equivalent) that doesn't have ambiguities.
-// The ambiguity is in
-// trait-property:
-// trait-property-name <- (a)
-// trait-property-clause
-// trait-property-expression <- (b)
-// trait-property-extension <- this conflicts with (a) and (b)
-// trait-property-extension:
-// trait-property-name <- conflict with (a)
-// identifier(trait-property-extension[, trait-property-extension[, ...]])
-// constant integer expression <- conflict with (b)
+// scalar-expr |
+// trait-property-name (trait-property-extension, ...)
//
struct OmpTraitPropertyExtension {
CharBlock source;
- TUPLE_CLASS_BOILERPLATE(OmpTraitPropertyExtension);
- struct ExtensionValue {
+ UNION_CLASS_BOILERPLATE(OmpTraitPropertyExtension);
+ struct Complex { // name (prop-ext, prop-ext, ...)
CharBlock source;
- UNION_CLASS_BOILERPLATE(ExtensionValue);
- std::variant<OmpTraitPropertyName, ScalarExpr,
- common::Indirection<OmpTraitPropertyExtension>>
- u;
+ TUPLE_CLASS_BOILERPLATE(Complex);
+ std::tuple<OmpTraitPropertyName,
+ std::list<common::Indirection<OmpTraitPropertyExtension>>>
+ t;
};
- using ExtensionList = std::list<ExtensionValue>;
- std::tuple<OmpTraitPropertyName, ExtensionList> t;
+
+ std::variant<OmpTraitPropertyName, ScalarExpr, Complex> u;
};
// trait-property ->
@@ -3568,9 +3553,10 @@ struct OmpTraitProperty {
// UID | T // unique-string-id /impl-defined
// VENDOR | I // name-list (vendor-id /add-def-doc)
// EXTENSION | I // name-list (ext_name /impl-defined)
-// ATOMIC_DEFAULT_MEM_ORDER I | // value of admo
+// ATOMIC_DEFAULT_MEM_ORDER I | // clause-list (value of admo)
// REQUIRES | I // clause-list (from requires)
// CONDITION U // logical-expr
+// <other name> I // treated as extension
//
// Trait-set-selectors:
// [D]evice, [T]arget_device, [C]onstruct, [I]mplementation, [U]ser.
@@ -3579,7 +3565,7 @@ struct OmpTraitSelectorName {
UNION_CLASS_BOILERPLATE(OmpTraitSelectorName);
ENUM_CLASS(Value, Arch, Atomic_Default_Mem_Order, Condition, Device_Num,
Extension, Isa, Kind, Requires, Simd, Uid, Vendor)
- std::variant<Value, llvm::omp::Directive> u;
+ std::variant<Value, llvm::omp::Directive, std::string> u;
};
// trait-selector ->
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 5ff91da082c852..a7b3986845d985 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -158,31 +158,23 @@ static TypeDeclarationStmt makeIterSpecDecl(std::list<ObjectName> &&names) {
static std::string nameToString(Name &&name) { return name.ToString(); }
TYPE_PARSER(sourced(construct<OmpTraitPropertyName>( //
- (space >> charLiteralConstantWithoutKind) ||
- applyFunction(nameToString, Parser<Name>{}))))
+ construct<OmpTraitPropertyName>(space >> charLiteralConstantWithoutKind) ||
+ construct<OmpTraitPropertyName>(
+ applyFunction(nameToString, Parser<Name>{})))))
TYPE_PARSER(sourced(construct<OmpTraitScore>( //
- "SCORE" >> parenthesized(scalarIntExpr))))
+ "SCORE"_tok >> parenthesized(scalarIntExpr))))
-TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension::ExtensionValue>(
- // Parse nested extension first.
- construct<OmpTraitPropertyExtension::ExtensionValue>(
- indirect(Parser<OmpTraitPropertyExtension>{})) ||
- construct<OmpTraitPropertyExtension::ExtensionValue>(
- Parser<OmpTraitPropertyName>{}) ||
- construct<OmpTraitPropertyExtension::ExtensionValue>(scalarExpr))))
-
-TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension>( //
+TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension::Complex>(
Parser<OmpTraitPropertyName>{},
parenthesized(nonemptySeparated(
- Parser<OmpTraitPropertyExtension::ExtensionValue>{}, ","_tok)))))
+ indirect(Parser<OmpTraitPropertyExtension>{}), ","_tok)))))
-TYPE_PARSER(sourced(construct<OmpTraitProperty>(
- // Try clause first, then extension before OmpTraitPropertyName.
- construct<OmpTraitProperty>(indirect(Parser<OmpClause>{})) ||
- construct<OmpTraitProperty>(Parser<OmpTraitPropertyExtension>{}) ||
- construct<OmpTraitProperty>(Parser<OmpTraitPropertyName>{}) ||
- construct<OmpTraitProperty>(scalarExpr))))
+TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension>(
+ construct<OmpTraitPropertyExtension>(
+ Parser<OmpTraitPropertyExtension::Complex>{}) ||
+ construct<OmpTraitPropertyExtension>(Parser<OmpTraitPropertyName>{}) ||
+ construct<OmpTraitPropertyExtension>(scalarExpr))))
TYPE_PARSER(construct<OmpTraitSelectorName::Value>(
"ARCH" >> pure(OmpTraitSelectorName::Value::Arch) ||
@@ -201,15 +193,96 @@ TYPE_PARSER(construct<OmpTraitSelectorName::Value>(
TYPE_PARSER(sourced(construct<OmpTraitSelectorName>(
// Parse predefined names first (because of SIMD).
construct<OmpTraitSelectorName>(Parser<OmpTraitSelectorName::Value>{}) ||
- construct<OmpTraitSelectorName>(OmpDirectiveNameParser{}))))
+ construct<OmpTraitSelectorName>(OmpDirectiveNameParser{}) ||
+ // identifier-or-string for extensions
+ construct<OmpTraitSelectorName>(
+ applyFunction(nameToString, Parser<Name>{})) ||
+ construct<OmpTraitSelectorName>(space >> charLiteralConstantWithoutKind))))
+
+// Parser for OmpTraitSelector::Properties
+template <typename... PropParser>
+static constexpr auto propertyListParser(PropParser... pp) {
+ // Parse the property list "(score(expr): item1...)" in three steps:
+ // 1. Parse the "("
+ // 2. Parse the optional "score(expr):"
+ // 3. Parse the "item1, ...)", together with the ")".
+ // The reason for including the ")" in the 3rd step is to force parsing
+ // the entire list in each of the alternative property parsers. Otherwise,
+ // the name parser could stop after "foo" in "(foo, bar(1))", without
+ // allowing the next parser to give the list a try.
+
+ using P = OmpTraitProperty;
+ return maybe("(" >>
+ construct<OmpTraitSelector::Properties>(
+ maybe(Parser<OmpTraitScore>{} / ":"_tok),
+ (attempt(nonemptySeparated(construct<P>(pp), ","_tok) / ")"_tok) ||
+ ...)));
+}
+
+// Parser for OmpTraitSelector
+struct TraitSelectorParser {
+ using resultType = OmpTraitSelector;
+
+ constexpr TraitSelectorParser(Parser<OmpTraitSelectorName> p) : np(p) {}
+
+ std::optional<resultType> Parse(ParseState &state) const {
+ auto name{attempt(np).Parse(state)};
+ if (!name.has_value()) {
+ return std::nullopt;
+ }
+
+ // Default fallback parser for lists that cannot be parser using the
+ // primary property parser.
+ auto extParser{Parser<OmpTraitPropertyExtension>{}};
+
+ if (auto *v{std::get_if<OmpTraitSelectorName::Value>(&name->u)}) {
+ switch (*v) {
+ // name-list properties
+ case OmpTraitSelectorName::Value::Arch: // [6.0:319:18]
+ case OmpTraitSelectorName::Value::Extension: // [6.0:319:30]
+ case OmpTraitSelectorName::Value::Isa: // [6.0:319:15]
+ case OmpTraitSelectorName::Value::Kind: // [6.0:319:10]
+ case OmpTraitSelectorName::Value::Uid: // [6.0:319:23](*)
+ case OmpTraitSelectorName::Value::Vendor: { // [6.0:319:27]
+ auto pp{propertyListParser(Parser<OmpTraitPropertyName>{}, extParser)};
+ return OmpTraitSelector(std::move(*name), std::move(*pp.Parse(state)));
+ }
+ // clause-list
+ case OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
+ // [6.0:321:26-29](*)
+ case OmpTraitSelectorName::Value::Requires: // [6.0:319:33]
+ case OmpTraitSelectorName::Value::Simd: { // [6.0:318:31]
+ auto pp{propertyListParser(indirect(Parser<OmpClause>{}), extParser)};
+ return OmpTraitSelector(std::move(*name), std::move(*pp.Parse(state)));
+ }
+ // expr-list
+ case OmpTraitSelectorName::Value::Condition: // [6.0:321:33](*)
+ case OmpTraitSelectorName::Value::Device_Num: { // [6.0:321:23-24](*)
+ auto pp{propertyListParser(scalarExpr, extParser)};
+ return OmpTraitSelector(std::move(*name), std::move(*pp.Parse(state)));
+ }
+ // (*) The spec doesn't assign any list-type to these traits, but for
+ // convenience they can be treated as if they were.
+ } // switch
+ } else {
+ // The other alternatives are `llvm::omp::Directive`, and `std::string`.
+ // The former doesn't take any properties[1], the latter is a name of an
+ // extension[2].
+ // [1] [6.0:319:1-2]
+ // [2] [6.0:319:36-37]
+ auto pp{propertyListParser(extParser)};
+ return OmpTraitSelector(std::move(*name), std::move(*pp.Parse(state)));
+ }
-TYPE_PARSER(construct<OmpTraitSelector::Properties>(
- maybe(Parser<OmpTraitScore>{} / ":"_tok),
- nonemptySeparated(Parser<OmpTraitProperty>{}, ","_tok)))
+ llvm_unreachable("Unhandled trait name?");
+ }
+
+private:
+ const Parser<OmpTraitSelectorName> np;
+};
-TYPE_PARSER(sourced(construct<OmpTraitSelector>( //
- Parser<OmpTraitSelectorName>{}, //
- maybe(parenthesized(Parser<OmpTraitSelector::Properties>{})))))
+TYPE_PARSER(construct<OmpTraitSelector>(
+ TraitSelectorParser(Parser<OmpTraitSelectorName>{})))
TYPE_PARSER(construct<OmpTraitSetSelectorName::Value>(
"CONSTRUCT" >> pure(OmpTraitSetSelectorName::Value::Construct) ||
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 7bf404bba2c3e4..af5259e1daec43 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2075,10 +2075,11 @@ class UnparseVisitor {
Walk(x.v);
Put(")");
}
- void Unparse(const OmpTraitPropertyExtension &x) {
+ void Unparse(const OmpTraitPropertyExtension::Complex &x) {
+ using PropList = std::list<common::Indirection<OmpTraitPropertyExtension>>;
Walk(std::get<OmpTraitPropertyName>(x.t));
Put("(");
- Walk(std::get<OmpTraitPropertyExtension::ExtensionList>(x.t), ",");
+ Walk(std::get<PropList>(x.t), ",");
Put(")");
}
void Unparse(const OmpTraitSelector &x) {
>From fe3ec47965d5f970e26f9f729a21b61acf366053 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 12 Dec 2024 15:26:26 -0600
Subject: [PATCH 2/7] [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.
---
flang/include/flang/Parser/dump-parse-tree.h | 6 +
flang/include/flang/Parser/parse-tree.h | 49 ++++-
flang/lib/Lower/OpenMP/Clauses.cpp | 21 +-
flang/lib/Lower/OpenMP/Clauses.h | 1 +
flang/lib/Lower/OpenMP/OpenMP.cpp | 5 +
flang/lib/Parser/openmp-parsers.cpp | 29 ++-
flang/lib/Parser/unparse.cpp | 16 ++
flang/lib/Semantics/check-omp-structure.cpp | 30 +++
flang/lib/Semantics/check-omp-structure.h | 12 +-
flang/lib/Semantics/resolve-directives.cpp | 11 ++
flang/test/Parser/OpenMP/metadirective.f90 | 196 +++++++++++++++++++
llvm/include/llvm/Frontend/OpenMP/OMP.td | 9 +-
12 files changed, 377 insertions(+), 8 deletions(-)
create mode 100644 flang/test/Parser/OpenMP/metadirective.f90
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 49eeed0e7b4393..1323fd695d4439 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/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)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index f8175ea1de679e..db19608a8491ee 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/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;
};
diff --git a/flang/lib/Lower/OpenMP/Clauses.cpp b/flang/lib/Lower/OpenMP/Clauses.cpp
index b424e209d56da9..d60171552087fa 100644
--- a/flang/lib/Lower/OpenMP/Clauses.cpp
+++ b/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
diff --git a/flang/lib/Lower/OpenMP/Clauses.h b/flang/lib/Lower/OpenMP/Clauses.h
index 65282d243d87af..aea317b5907fff 100644
--- a/flang/lib/Lower/OpenMP/Clauses.h
+++ b/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>;
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 8a1029426d30c5..5c03d70b93095d 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/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,
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index a7b3986845d985..50a165d2513397 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/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)
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index af5259e1daec43..7d3b03e5bc27e7 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/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");
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 6db43cf6f04bd3..27b719e30961ab 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/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);
}
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index dc360957c873b7..da62264b62571d 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/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};
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 39478b58a9070d..52be8d13ef4710 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -351,6 +351,17 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
return true;
}
+ bool Pre(const parser::OmpDirectiveSpecification &x) {
+ PushContext(x.source, std::get<llvm::omp::Directive>(x.t));
+ return true;
+ }
+ void Post(const parser::OmpDirectiveSpecification &) { PopContext(); }
+ bool Pre(const parser::OmpMetadirectiveDirective &x) {
+ PushContext(x.source, llvm::omp::Directive::OMPD_metadirective);
+ return true;
+ }
+ void Post(const parser::OmpMetadirectiveDirective &) { PopContext(); }
+
bool Pre(const parser::OpenMPBlockConstruct &);
void Post(const parser::OpenMPBlockConstruct &);
diff --git a/flang/test/Parser/OpenMP/metadirective.f90 b/flang/test/Parser/OpenMP/metadirective.f90
new file mode 100644
index 00000000000000..f9e592b493f5e5
--- /dev/null
+++ b/flang/test/Parser/OpenMP/metadirective.f90
@@ -0,0 +1,196 @@
+!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=52 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
+!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=52 %s | FileCheck --check-prefix="PARSE-TREE" %s
+
+subroutine f00
+ !$omp metadirective when(construct={target, parallel}: nothing)
+end
+
+!UNPARSE: SUBROUTINE f00
+!UNPARSE: !$OMP METADIRECTIVE WHEN(CONSTRUCT={TARGET, PARALLEL}: NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Construct
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> llvm::omp::Directive = target
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> llvm::omp::Directive = parallel
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f10
+ !$omp metadirective when(device={kind(host), device_num(1)}: nothing)
+end
+
+!UNPARSE: SUBROUTINE f10
+!UNPARSE: !$OMP METADIRECTIVE WHEN(DEVICE={KIND(host), DEVICE_NUM(1_4)}: NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Device
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Kind
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> OmpTraitPropertyName -> string = 'host'
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Device_Num
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> Scalar -> Expr = '1_4'
+!PARSE-TREE: | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f20
+ !$omp metadirective when(target_device={kind(any), device_num(7)}: nothing)
+end
+
+!UNPARSE: SUBROUTINE f20
+!UNPARSE: !$OMP METADIRECTIVE WHEN(TARGET_DEVICE={KIND(any), DEVICE_NUM(7_4)}: NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Target_Device
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Kind
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> OmpTraitPropertyName -> string = 'any'
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Device_Num
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> Scalar -> Expr = '7_4'
+!PARSE-TREE: | | | | | | LiteralConstant -> IntLiteralConstant = '7'
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f30
+ !$omp metadirective &
+ !$omp when(implementation={atomic_default_mem_order(acq_rel)}: nothing)
+end
+
+!UNPARSE: SUBROUTINE f30
+!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={ATOMIC_DEFAULT_MEM_ORDER(ACQ_REL)}: &
+!UNPARSE: !$OMP&NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Implementation
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Atomic_Default_Mem_Order
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> OmpClause -> AcqRel
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f31
+ !$omp metadirective &
+ !$omp when(implementation={extension(haha(1), foo(baz, "bar"(1)))}: nothing)
+end
+
+!UNPARSE: SUBROUTINE f31
+!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={EXTENSION(haha(1_4), foo(baz,bar(1_4)))}: &
+!UNPARSE: !$OMP&NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Implementation
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Extension
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> OmpTraitPropertyExtension -> Complex
+!PARSE-TREE: | | | | | | OmpTraitPropertyName -> string = 'haha'
+!PARSE-TREE: | | | | | | OmpTraitPropertyExtension -> Scalar -> Expr = '1_4'
+!PARSE-TREE: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!PARSE-TREE: | | | | | OmpTraitProperty -> OmpTraitPropertyExtension
+!PARSE-TREE: | | | | | | OmpTraitPropertyName -> string = 'foo'
+!PARSE-TREE: | | | | | | OmpTraitPropertyExtension -> OmpTraitPropertyName -> string = 'baz'
+!PARSE-TREE: | | | | | | OmpTraitPropertyExtension -> Complex
+!PARSE-TREE: | | | | | | | OmpTraitPropertyName -> string = 'bar'
+!PARSE-TREE: | | | | | | | OmpTraitPropertyExtension -> Scalar -> Expr = '1_4'
+!PARSE-TREE: | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f40(x)
+ integer :: x
+ !$omp metadirective &
+ !$omp when(user={condition(score(100): .true.)}: &
+ !$omp parallel do reduction(+: x)) &
+ !$omp otherwise(nothing)
+ do i = 1, 10
+ enddo
+end
+
+!UNPARSE: SUBROUTINE f40 (x)
+!UNPARSE: INTEGER x
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(SCORE(100_4): .true._4)}: PARALLEL DO REDUCTION(+&
+!UNPARSE: !$OMP&: x)) OTHERWISE(NOTHING)
+!UNPARSE: DO i=1_4,10_4
+!UNPARSE: END DO
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = User
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Condition
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitScore -> Scalar -> Integer -> Expr = '100_4'
+!PARSE-TREE: | | | | | | LiteralConstant -> IntLiteralConstant = '100'
+!PARSE-TREE: | | | | | OmpTraitProperty -> Scalar -> Expr = '.true._4'
+!PARSE-TREE: | | | | | | LiteralConstant -> LogicalLiteralConstant
+!PARSE-TREE: | | | | | | | bool = 'true'
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = parallel do
+!PARSE-TREE: | | | OmpClauseList -> OmpClause -> Reduction -> OmpReductionClause
+!PARSE-TREE: | | | | Modifier -> OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add
+!PARSE-TREE: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | OmpClause -> Otherwise -> OmpOtherwiseClause -> OmpDirectiveSpecification
+!PARSE-TREE: | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | OmpClauseList ->
+
+subroutine f41
+ ! Two trait set selectors
+ !$omp metadirective &
+ !$omp when(implementation={vendor("amd")}, user={condition(.true.)}: nothing)
+end
+
+!UNPARSE: SUBROUTINE f41
+!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={VENDOR(amd)}, USER={CONDITION(.true._4)}: NO&
+!UNPARSE: !$OMP&THING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Implementation
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Vendor
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> OmpTraitPropertyName -> string = 'amd'
+!PARSE-TREE: | | OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = User
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Condition
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> Scalar -> Expr = '.true._4'
+!PARSE-TREE: | | | | | | LiteralConstant -> LogicalLiteralConstant
+!PARSE-TREE: | | | | | | | bool = 'true'
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
diff --git a/llvm/include/llvm/Frontend/OpenMP/OMP.td b/llvm/include/llvm/Frontend/OpenMP/OMP.td
index a4c1964c3e88f5..1f2389987e18bc 100644
--- a/llvm/include/llvm/Frontend/OpenMP/OMP.td
+++ b/llvm/include/llvm/Frontend/OpenMP/OMP.td
@@ -265,6 +265,7 @@ def OMPC_Map : Clause<"map"> {
let flangClass = "OmpMapClause";
}
def OMPC_Match : Clause<"match"> {
+ let flangClass = "OmpMatchClause";
}
def OMP_MEMORY_ORDER_SeqCst : ClauseVal<"seq_cst", 1, 1> {}
def OMP_MEMORY_ORDER_AcqRel : ClauseVal<"acq_rel", 2, 1> {}
@@ -367,6 +368,10 @@ def OMPC_Ordered : Clause<"ordered"> {
let flangClass = "ScalarIntConstantExpr";
let isValueOptional = true;
}
+def OMPC_Otherwise : Clause<"otherwise"> {
+ let flangClass = "OmpOtherwiseClause";
+ let isValueOptional = true;
+}
def OMPC_Partial: Clause<"partial"> {
let clangClass = "OMPPartialClause";
let flangClass = "ScalarIntConstantExpr";
@@ -524,6 +529,7 @@ def OMPC_Weak : Clause<"weak"> {
let clangClass = "OMPWeakClause";
}
def OMPC_When: Clause<"when"> {
+ let flangClass = "OmpWhenClause";
}
def OMPC_Write : Clause<"write"> {
let clangClass = "OMPWriteClause";
@@ -845,7 +851,8 @@ def OMP_Metadirective : Directive<"metadirective"> {
VersionedClause<OMPC_When>,
];
let allowedOnceClauses = [
- VersionedClause<OMPC_Default>,
+ VersionedClause<OMPC_Otherwise, 52>,
+ VersionedClause<OMPC_Default, 50, 51>,
];
let association = AS_None;
let category = CA_Meta;
>From c44051da5290258af794ddccf58fa6ab022edd32 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Tue, 14 Jan 2025 07:36:13 -0600
Subject: [PATCH 3/7] format/comment
---
flang/include/flang/Parser/parse-tree.h | 2 +-
flang/lib/Parser/openmp-parsers.cpp | 8 +++++---
2 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index f8175ea1de679e..88ce141d17cf92 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3512,7 +3512,7 @@ struct OmpTraitScore {
struct OmpTraitPropertyExtension {
CharBlock source;
UNION_CLASS_BOILERPLATE(OmpTraitPropertyExtension);
- struct Complex { // name (prop-ext, prop-ext, ...)
+ struct Complex { // name (prop-ext, prop-ext, ...)
CharBlock source;
TUPLE_CLASS_BOILERPLATE(Complex);
std::tuple<OmpTraitPropertyName,
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index a7b3986845d985..7e6259155b2266 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -236,11 +236,15 @@ struct TraitSelectorParser {
auto extParser{Parser<OmpTraitPropertyExtension>{}};
if (auto *v{std::get_if<OmpTraitSelectorName::Value>(&name->u)}) {
+ // (*) The comments below show the sections of the OpenMP spec that
+ // describe given trait. The cases marked with a (*) are those where
+ // the spec doesn't assign any list-type to these traits, but for
+ // convenience they can be treated as if they were.
switch (*v) {
// name-list properties
case OmpTraitSelectorName::Value::Arch: // [6.0:319:18]
case OmpTraitSelectorName::Value::Extension: // [6.0:319:30]
- case OmpTraitSelectorName::Value::Isa: // [6.0:319:15]
+ case OmpTraitSelectorName::Value::Isa: // [6.0:319:15]
case OmpTraitSelectorName::Value::Kind: // [6.0:319:10]
case OmpTraitSelectorName::Value::Uid: // [6.0:319:23](*)
case OmpTraitSelectorName::Value::Vendor: { // [6.0:319:27]
@@ -261,8 +265,6 @@ struct TraitSelectorParser {
auto pp{propertyListParser(scalarExpr, extParser)};
return OmpTraitSelector(std::move(*name), std::move(*pp.Parse(state)));
}
- // (*) The spec doesn't assign any list-type to these traits, but for
- // convenience they can be treated as if they were.
} // switch
} else {
// The other alternatives are `llvm::omp::Directive`, and `std::string`.
>From 13740f921868ebb0bbc1b407db1f399211456149 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Tue, 14 Jan 2025 08:58:24 -0600
Subject: [PATCH 4/7] add "sourced"
---
flang/lib/Parser/openmp-parsers.cpp | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 7e6259155b2266..029226d523ba9e 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -210,13 +210,15 @@ static constexpr auto propertyListParser(PropParser... pp) {
// the entire list in each of the alternative property parsers. Otherwise,
// the name parser could stop after "foo" in "(foo, bar(1))", without
// allowing the next parser to give the list a try.
+ auto listOf{[](auto parser) { //
+ return nonemptySeparated(parser, ","_tok);
+ }};
using P = OmpTraitProperty;
- return maybe("(" >>
+ return maybe("(" >> //
construct<OmpTraitSelector::Properties>(
maybe(Parser<OmpTraitScore>{} / ":"_tok),
- (attempt(nonemptySeparated(construct<P>(pp), ","_tok) / ")"_tok) ||
- ...)));
+ (attempt(listOf(sourced(construct<P>(pp))) / ")"_tok) || ...)));
}
// Parser for OmpTraitSelector
@@ -283,8 +285,8 @@ struct TraitSelectorParser {
const Parser<OmpTraitSelectorName> np;
};
-TYPE_PARSER(construct<OmpTraitSelector>(
- TraitSelectorParser(Parser<OmpTraitSelectorName>{})))
+TYPE_PARSER(sourced(construct<OmpTraitSelector>(
+ sourced(TraitSelectorParser(Parser<OmpTraitSelectorName>{})))))
TYPE_PARSER(construct<OmpTraitSetSelectorName::Value>(
"CONSTRUCT" >> pure(OmpTraitSetSelectorName::Value::Construct) ||
>From 527315fc389df871c622f43124e5305571ee6ac3 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Wed, 15 Jan 2025 12:19:18 -0600
Subject: [PATCH 5/7] fix parser
---
flang/lib/Parser/openmp-parsers.cpp | 47 +++++++++++++++--------------
1 file changed, 24 insertions(+), 23 deletions(-)
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 029226d523ba9e..30e4d4d491d584 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -163,12 +163,12 @@ TYPE_PARSER(sourced(construct<OmpTraitPropertyName>( //
applyFunction(nameToString, Parser<Name>{})))))
TYPE_PARSER(sourced(construct<OmpTraitScore>( //
- "SCORE"_tok >> parenthesized(scalarIntExpr))))
+ "SCORE"_id >> parenthesized(scalarIntExpr))))
TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension::Complex>(
Parser<OmpTraitPropertyName>{},
parenthesized(nonemptySeparated(
- indirect(Parser<OmpTraitPropertyExtension>{}), ","_tok)))))
+ indirect(Parser<OmpTraitPropertyExtension>{}), ",")))))
TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension>(
construct<OmpTraitPropertyExtension>(
@@ -177,18 +177,18 @@ TYPE_PARSER(sourced(construct<OmpTraitPropertyExtension>(
construct<OmpTraitPropertyExtension>(scalarExpr))))
TYPE_PARSER(construct<OmpTraitSelectorName::Value>(
- "ARCH" >> pure(OmpTraitSelectorName::Value::Arch) ||
- "ATOMIC_DEFAULT_MEM_ORDER" >>
+ "ARCH"_id >> pure(OmpTraitSelectorName::Value::Arch) ||
+ "ATOMIC_DEFAULT_MEM_ORDER"_id >>
pure(OmpTraitSelectorName::Value::Atomic_Default_Mem_Order) ||
- "CONDITION" >> pure(OmpTraitSelectorName::Value::Condition) ||
- "DEVICE_NUM" >> pure(OmpTraitSelectorName::Value::Device_Num) ||
- "EXTENSION" >> pure(OmpTraitSelectorName::Value::Extension) ||
- "ISA" >> pure(OmpTraitSelectorName::Value::Isa) ||
- "KIND" >> pure(OmpTraitSelectorName::Value::Kind) ||
- "REQUIRES" >> pure(OmpTraitSelectorName::Value::Requires) ||
- "SIMD" >> pure(OmpTraitSelectorName::Value::Simd) ||
- "UID" >> pure(OmpTraitSelectorName::Value::Uid) ||
- "VENDOR" >> pure(OmpTraitSelectorName::Value::Vendor)))
+ "CONDITION"_id >> pure(OmpTraitSelectorName::Value::Condition) ||
+ "DEVICE_NUM"_id >> pure(OmpTraitSelectorName::Value::Device_Num) ||
+ "EXTENSION"_id >> pure(OmpTraitSelectorName::Value::Extension) ||
+ "ISA"_id >> pure(OmpTraitSelectorName::Value::Isa) ||
+ "KIND"_id >> pure(OmpTraitSelectorName::Value::Kind) ||
+ "REQUIRES"_id >> pure(OmpTraitSelectorName::Value::Requires) ||
+ "SIMD"_id >> pure(OmpTraitSelectorName::Value::Simd) ||
+ "UID"_id >> pure(OmpTraitSelectorName::Value::Uid) ||
+ "VENDOR"_id >> pure(OmpTraitSelectorName::Value::Vendor)))
TYPE_PARSER(sourced(construct<OmpTraitSelectorName>(
// Parse predefined names first (because of SIMD).
@@ -211,14 +211,14 @@ static constexpr auto propertyListParser(PropParser... pp) {
// the name parser could stop after "foo" in "(foo, bar(1))", without
// allowing the next parser to give the list a try.
auto listOf{[](auto parser) { //
- return nonemptySeparated(parser, ","_tok);
+ return nonemptySeparated(parser, ",");
}};
using P = OmpTraitProperty;
return maybe("(" >> //
construct<OmpTraitSelector::Properties>(
- maybe(Parser<OmpTraitScore>{} / ":"_tok),
- (attempt(listOf(sourced(construct<P>(pp))) / ")"_tok) || ...)));
+ maybe(Parser<OmpTraitScore>{} / ":"),
+ (attempt(listOf(sourced(construct<P>(pp))) / ")") || ...)));
}
// Parser for OmpTraitSelector
@@ -289,21 +289,22 @@ TYPE_PARSER(sourced(construct<OmpTraitSelector>(
sourced(TraitSelectorParser(Parser<OmpTraitSelectorName>{})))))
TYPE_PARSER(construct<OmpTraitSetSelectorName::Value>(
- "CONSTRUCT" >> pure(OmpTraitSetSelectorName::Value::Construct) ||
- "DEVICE" >> pure(OmpTraitSetSelectorName::Value::Device) ||
- "IMPLEMENTATION" >> pure(OmpTraitSetSelectorName::Value::Implementation) ||
- "TARGET_DEVICE" >> pure(OmpTraitSetSelectorName::Value::Target_Device) ||
- "USER" >> pure(OmpTraitSetSelectorName::Value::User)))
+ "CONSTRUCT"_id >> pure(OmpTraitSetSelectorName::Value::Construct) ||
+ "DEVICE"_id >> pure(OmpTraitSetSelectorName::Value::Device) ||
+ "IMPLEMENTATION"_id >>
+ pure(OmpTraitSetSelectorName::Value::Implementation) ||
+ "TARGET_DEVICE"_id >> pure(OmpTraitSetSelectorName::Value::Target_Device) ||
+ "USER"_id >> pure(OmpTraitSetSelectorName::Value::User)))
TYPE_PARSER(sourced(construct<OmpTraitSetSelectorName>(
Parser<OmpTraitSetSelectorName::Value>{})))
TYPE_PARSER(sourced(construct<OmpTraitSetSelector>( //
Parser<OmpTraitSetSelectorName>{},
- "=" >> braced(nonemptySeparated(Parser<OmpTraitSelector>{}, ","_tok)))))
+ "=" >> braced(nonemptySeparated(Parser<OmpTraitSelector>{}, ",")))))
TYPE_PARSER(sourced(construct<OmpContextSelectorSpecification>(
- nonemptySeparated(Parser<OmpTraitSetSelector>{}, ","_tok))))
+ nonemptySeparated(Parser<OmpTraitSetSelector>{}, ","))))
// Parser<OmpContextSelector> == Parser<traits::OmpContextSelectorSpecification>
>From 4c5b3ce357c3fd92d3d4b1a3ad32dbf658d54b46 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 16 Jan 2025 13:35:51 -0600
Subject: [PATCH 6/7] add missing visitor for OmpMetadirectiveDirective
---
flang/lib/Lower/OpenMP/OpenMP.cpp | 3 +++
1 file changed, 3 insertions(+)
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 2f6e96637e6620..3a4336fe5b90f9 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -413,6 +413,9 @@ extractOmpDirective(const parser::OpenMPConstruct &ompConstruct) {
[](const parser::OpenMPCancellationPointConstruct &c) {
return llvm::omp::OMPD_cancellation_point;
},
+ [](const parser::OmpMetadirectiveDirective &c) {
+ return llvm::omp::OMPD_metadirective;
+ },
[](const parser::OpenMPDepobjConstruct &c) {
return llvm::omp::OMPD_depobj;
}},
>From 205a760748765023daf197ed4da2a3f54ba32d47 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 16 Jan 2025 15:09:29 -0600
Subject: [PATCH 7/7] support for default
---
flang/include/flang/Parser/parse-tree.h | 8 +++-
flang/lib/Lower/OpenMP/Clauses.cpp | 40 ++++++++++++++-----
flang/lib/Parser/openmp-parsers.cpp | 7 +++-
flang/lib/Semantics/check-omp-structure.cpp | 5 +++
flang/lib/Semantics/resolve-directives.cpp | 33 ++++++++-------
.../test/Parser/OpenMP/metadirective-v50.f90 | 29 ++++++++++++++
flang/test/Parser/OpenMP/metadirective.f90 | 38 +++++++++---------
7 files changed, 116 insertions(+), 44 deletions(-)
create mode 100644 flang/test/Parser/OpenMP/metadirective-v50.f90
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 0cf8527730581b..71afb6d2ae75a7 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3967,15 +3967,21 @@ struct OmpBindClause {
// Ref: [4.5:46-50], [5.0:74-78], [5.1:92-96], [5.2:109]
//
+// When used as a data-sharing clause:
// default-clause ->
// DEFAULT(data-sharing-attribute) // since 4.5
// data-sharing-attribute ->
// SHARED | NONE | // since 4.5
// PRIVATE | FIRSTPRIVATE // since 5.0
+//
+// When used in METADIRECTIVE:
+// default-clause ->
+// DEFAULT(directive-specification) // since 5.0, until 5.1
// See also otherwise-clause.
struct OmpDefaultClause {
ENUM_CLASS(DataSharingAttribute, Private, Firstprivate, Shared, None)
- WRAPPER_CLASS_BOILERPLATE(OmpDefaultClause, DataSharingAttribute);
+ UNION_CLASS_BOILERPLATE(OmpDefaultClause);
+ std::variant<DataSharingAttribute, OmpDirectiveSpecification> u;
};
// Ref: [4.5:103-107], [5.0:324-325], [5.1:357-358], [5.2:161-162]
diff --git a/flang/lib/Lower/OpenMP/Clauses.cpp b/flang/lib/Lower/OpenMP/Clauses.cpp
index d60171552087fa..db6486abc7ea1e 100644
--- a/flang/lib/Lower/OpenMP/Clauses.cpp
+++ b/flang/lib/Lower/OpenMP/Clauses.cpp
@@ -230,9 +230,6 @@ MAKE_EMPTY_CLASS(Threadprivate, Threadprivate);
MAKE_INCOMPLETE_CLASS(AdjustArgs, AdjustArgs);
MAKE_INCOMPLETE_CLASS(AppendArgs, AppendArgs);
-// MAKE_INCOMPLETE_CLASS(Match, Match);
-// MAKE_INCOMPLETE_CLASS(Otherwise, ); // missing-in-parser
-// MAKE_INCOMPLETE_CLASS(When, When);
List<IteratorSpecifier>
makeIteratorSpecifiers(const parser::OmpIteratorSpecifier &inp,
@@ -528,8 +525,13 @@ Copyprivate make(const parser::OmpClause::Copyprivate &inp,
return Copyprivate{/*List=*/makeObjects(inp.v, semaCtx)};
}
-Default make(const parser::OmpClause::Default &inp,
- semantics::SemanticsContext &semaCtx) {
+// The Default clause is overloaded in OpenMP 5.0 and 5.1: it can be either
+// a data-sharing clause, or a METADIRECTIVE clause. In the latter case, it
+// has been superseded by the OTHERWISE clause.
+// Disambiguate this in this representation: for the DSA case, create Default,
+// and in the other case create Otherwise.
+Default makeDefault(const parser::OmpClause::Default &inp,
+ semantics::SemanticsContext &semaCtx) {
// inp.v -> parser::OmpDefaultClause
using wrapped = parser::OmpDefaultClause;
@@ -543,7 +545,13 @@ Default make(const parser::OmpClause::Default &inp,
// clang-format on
);
- return Default{/*DataSharingAttribute=*/convert(inp.v.v)};
+ auto dsa = std::get<wrapped::DataSharingAttribute>(inp.v.u);
+ return Default{/*DataSharingAttribute=*/convert(dsa)};
+}
+
+Otherwise makeOtherwise(const parser::OmpClause::Default &inp,
+ semantics::SemanticsContext &semaCtx) {
+ return Otherwise{};
}
Defaultmap make(const parser::OmpClause::Defaultmap &inp,
@@ -1105,7 +1113,7 @@ Ordered make(const parser::OmpClause::Ordered &inp,
return Ordered{/*N=*/maybeApply(makeExprFn(semaCtx), inp.v)};
}
-// Otherwise: incomplete, missing-in-parser
+// See also Default.
Otherwise make(const parser::OmpClause::Otherwise &inp,
semantics::SemanticsContext &semaCtx) {
return Otherwise{};
@@ -1375,9 +1383,21 @@ When make(const parser::OmpClause::When &inp,
Clause makeClause(const parser::OmpClause &cls,
semantics::SemanticsContext &semaCtx) {
- return Fortran::common::visit(
- [&](auto &&s) {
- return makeClause(cls.Id(), clause::make(s, semaCtx), cls.source);
+ return Fortran::common::visit( //
+ common::visitors{
+ [&](const parser::OmpClause::Default &s) {
+ using DSA = parser::OmpDefaultClause::DataSharingAttribute;
+ if (std::holds_alternative<DSA>(s.v.u)) {
+ return makeClause(llvm::omp::Clause::OMPC_default,
+ clause::makeDefault(s, semaCtx), cls.source);
+ } else {
+ return makeClause(llvm::omp::Clause::OMPC_otherwise,
+ clause::makeOtherwise(s, semaCtx), cls.source);
+ }
+ },
+ [&](auto &&s) {
+ return makeClause(cls.Id(), clause::make(s, semaCtx), cls.source);
+ },
},
cls.u);
}
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index fa2679684ffe73..e3c9292bc5f91e 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -533,13 +533,18 @@ TYPE_PARSER(construct<OmpAffinityClause>(
Parser<OmpObjectList>{}))
// 2.15.3.1 DEFAULT (PRIVATE | FIRSTPRIVATE | SHARED | NONE)
-TYPE_PARSER(construct<OmpDefaultClause>(
+TYPE_PARSER(construct<OmpDefaultClause::DataSharingAttribute>(
"PRIVATE" >> pure(OmpDefaultClause::DataSharingAttribute::Private) ||
"FIRSTPRIVATE" >>
pure(OmpDefaultClause::DataSharingAttribute::Firstprivate) ||
"SHARED" >> pure(OmpDefaultClause::DataSharingAttribute::Shared) ||
"NONE" >> pure(OmpDefaultClause::DataSharingAttribute::None)))
+TYPE_PARSER(construct<OmpDefaultClause>(
+ construct<OmpDefaultClause>(
+ Parser<OmpDefaultClause::DataSharingAttribute>{}) ||
+ construct<OmpDefaultClause>(Parser<OmpDirectiveSpecification>{})))
+
// 2.5 PROC_BIND (MASTER | CLOSE | PRIMARY | SPREAD)
TYPE_PARSER(construct<OmpProcBindClause>(
"CLOSE" >> pure(OmpProcBindClause::AffinityPolicy::Close) ||
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 27b719e30961ab..d732233388d4fe 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -215,6 +215,11 @@ class AssociatedLoopChecker {
bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
// Do not do clause checks while processing METADIRECTIVE.
+ // Context selectors can contain clauses that are not given as a part
+ // of a construct, but as trait properties. Testing whether they are
+ // valid or not is deferred to the checks of the context selectors.
+ // As it stands now, these clauses would appear as if they were present
+ // on METADIRECTIVE, leading to incorrect diagnostics.
if (GetDirectiveNest(ContextSelectorNest) > 0) {
return true;
}
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 52be8d13ef4710..ea5dba87ae0006 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2028,20 +2028,25 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) {
}
void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
- if (!dirContext_.empty()) {
- switch (x.v) {
- case parser::OmpDefaultClause::DataSharingAttribute::Private:
- SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
- break;
- case parser::OmpDefaultClause::DataSharingAttribute::Firstprivate:
- SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
- break;
- case parser::OmpDefaultClause::DataSharingAttribute::Shared:
- SetContextDefaultDSA(Symbol::Flag::OmpShared);
- break;
- case parser::OmpDefaultClause::DataSharingAttribute::None:
- SetContextDefaultDSA(Symbol::Flag::OmpNone);
- break;
+ // The DEFAULT clause may also be used on METADIRECTIVE. In that case
+ // there is nothing to do.
+ using DataSharingAttribute = parser::OmpDefaultClause::DataSharingAttribute;
+ if (auto *dsa{std::get_if<DataSharingAttribute>(&x.u)}) {
+ if (!dirContext_.empty()) {
+ switch (*dsa) {
+ case DataSharingAttribute::Private:
+ SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
+ break;
+ case DataSharingAttribute::Firstprivate:
+ SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
+ break;
+ case DataSharingAttribute::Shared:
+ SetContextDefaultDSA(Symbol::Flag::OmpShared);
+ break;
+ case DataSharingAttribute::None:
+ SetContextDefaultDSA(Symbol::Flag::OmpNone);
+ break;
+ }
}
}
}
diff --git a/flang/test/Parser/OpenMP/metadirective-v50.f90 b/flang/test/Parser/OpenMP/metadirective-v50.f90
new file mode 100644
index 00000000000000..73d5077da3d9f1
--- /dev/null
+++ b/flang/test/Parser/OpenMP/metadirective-v50.f90
@@ -0,0 +1,29 @@
+!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=50 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
+!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=50 %s | FileCheck --check-prefix="PARSE-TREE" %s
+
+subroutine f01
+ !$omp metadirective &
+ !$omp & when(user={condition(.true.)}: nothing) &
+ !$omp & default(nothing)
+end
+
+!UNPARSE: SUBROUTINE f01
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: NOTHING) DEFAULT(NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
+!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
+!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
+!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = User
+!PARSE-TREE: | | | OmpTraitSelector
+!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Condition
+!PARSE-TREE: | | | | Properties
+!PARSE-TREE: | | | | | OmpTraitProperty -> Scalar -> Expr = '.true._4'
+!PARSE-TREE: | | | | | | LiteralConstant -> LogicalLiteralConstant
+!PARSE-TREE: | | | | | | | bool = 'true'
+!PARSE-TREE: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | | OmpClauseList ->
+!PARSE-TREE: | OmpClause -> Default -> OmpDefaultClause -> OmpDirectiveSpecification
+!PARSE-TREE: | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | OmpClauseList ->
diff --git a/flang/test/Parser/OpenMP/metadirective.f90 b/flang/test/Parser/OpenMP/metadirective.f90
index f9e592b493f5e5..af6c3bbefacf24 100644
--- a/flang/test/Parser/OpenMP/metadirective.f90
+++ b/flang/test/Parser/OpenMP/metadirective.f90
@@ -21,11 +21,11 @@ subroutine f00
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
-subroutine f10
+subroutine f01
!$omp metadirective when(device={kind(host), device_num(1)}: nothing)
end
-!UNPARSE: SUBROUTINE f10
+!UNPARSE: SUBROUTINE f01
!UNPARSE: !$OMP METADIRECTIVE WHEN(DEVICE={KIND(host), DEVICE_NUM(1_4)}: NOTHING)
!UNPARSE: END SUBROUTINE
@@ -46,11 +46,11 @@ subroutine f10
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
-subroutine f20
+subroutine f02
!$omp metadirective when(target_device={kind(any), device_num(7)}: nothing)
end
-!UNPARSE: SUBROUTINE f20
+!UNPARSE: SUBROUTINE f02
!UNPARSE: !$OMP METADIRECTIVE WHEN(TARGET_DEVICE={KIND(any), DEVICE_NUM(7_4)}: NOTHING)
!UNPARSE: END SUBROUTINE
@@ -71,12 +71,12 @@ subroutine f20
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
-subroutine f30
+subroutine f03
!$omp metadirective &
- !$omp when(implementation={atomic_default_mem_order(acq_rel)}: nothing)
+ !$omp & when(implementation={atomic_default_mem_order(acq_rel)}: nothing)
end
-!UNPARSE: SUBROUTINE f30
+!UNPARSE: SUBROUTINE f03
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={ATOMIC_DEFAULT_MEM_ORDER(ACQ_REL)}: &
!UNPARSE: !$OMP&NOTHING)
!UNPARSE: END SUBROUTINE
@@ -93,12 +93,12 @@ subroutine f30
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
-subroutine f31
+subroutine f04
!$omp metadirective &
- !$omp when(implementation={extension(haha(1), foo(baz, "bar"(1)))}: nothing)
+ !$omp & when(implementation={extension(haha(1), foo(baz, "bar"(1)))}: nothing)
end
-!UNPARSE: SUBROUTINE f31
+!UNPARSE: SUBROUTINE f04
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={EXTENSION(haha(1_4), foo(baz,bar(1_4)))}: &
!UNPARSE: !$OMP&NOTHING)
!UNPARSE: END SUBROUTINE
@@ -125,17 +125,17 @@ subroutine f31
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
-subroutine f40(x)
+subroutine f05(x)
integer :: x
!$omp metadirective &
- !$omp when(user={condition(score(100): .true.)}: &
- !$omp parallel do reduction(+: x)) &
- !$omp otherwise(nothing)
+ !$omp & when(user={condition(score(100): .true.)}: &
+ !$omp & parallel do reduction(+: x)) &
+ !$omp & otherwise(nothing)
do i = 1, 10
enddo
end
-!UNPARSE: SUBROUTINE f40 (x)
+!UNPARSE: SUBROUTINE f05 (x)
!UNPARSE: INTEGER x
!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(SCORE(100_4): .true._4)}: PARALLEL DO REDUCTION(+&
!UNPARSE: !$OMP&: x)) OTHERWISE(NOTHING)
@@ -164,13 +164,14 @@ subroutine f40(x)
!PARSE-TREE: | | llvm::omp::Directive = nothing
!PARSE-TREE: | | OmpClauseList ->
-subroutine f41
+subroutine f06
! Two trait set selectors
!$omp metadirective &
- !$omp when(implementation={vendor("amd")}, user={condition(.true.)}: nothing)
+ !$omp & when(implementation={vendor("amd")}, &
+ !$omp & user={condition(.true.)}: nothing)
end
-!UNPARSE: SUBROUTINE f41
+!UNPARSE: SUBROUTINE f06
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={VENDOR(amd)}, USER={CONDITION(.true._4)}: NO&
!UNPARSE: !$OMP&THING)
!UNPARSE: END SUBROUTINE
@@ -194,3 +195,4 @@ subroutine f41
!PARSE-TREE: | | OmpDirectiveSpecification
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
+
More information about the flang-commits
mailing list