[flang-commits] [flang] [llvm] [flang][OpenMP] Handle directive arguments in OmpDirectiveSpecifier (PR #124278)
Krzysztof Parzyszek via flang-commits
flang-commits at lists.llvm.org
Mon Feb 3 10:17:04 PST 2025
https://github.com/kparzysz updated https://github.com/llvm/llvm-project/pull/124278
>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 01/13] [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 11725991e9c9a96..49eeed0e7b43931 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 00d85aa05fb3a52..f8175ea1de679ef 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 5ff91da082c8527..a7b3986845d985d 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 7bf404bba2c3e43..af5259e1daec43f 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 02/13] [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 49eeed0e7b43931..1323fd695d44393 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 f8175ea1de679ef..db19608a8491ee1 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 b424e209d56da93..d60171552087fa0 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 65282d243d87af0..aea317b5907fff1 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 8a1029426d30c51..5c03d70b93095dc 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 a7b3986845d985d..50a165d2513397d 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 af5259e1daec43f..7d3b03e5bc27e72 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 6db43cf6f04bd34..27b719e30961ab3 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 dc360957c873b72..da62264b62571d1 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 39478b58a9070d5..52be8d13ef4710c 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 000000000000000..f9e592b493f5e51
--- /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 a4c1964c3e88f55..1f2389987e18bc2 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 03/13] 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 f8175ea1de679ef..88ce141d17cf925 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 a7b3986845d985d..7e6259155b22665 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 04/13] 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 7e6259155b22665..029226d523ba9e8 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 05/13] 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 029226d523ba9e8..30e4d4d491d5844 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 06/13] 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 2f6e96637e66207..3a4336fe5b90f9b 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 07/13] 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 0cf8527730581b5..71afb6d2ae75a7e 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 d60171552087fa0..db6486abc7ea1e1 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 fa2679684ffe73c..e3c9292bc5f91e3 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 27b719e30961ab3..d732233388d4fe3 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 52be8d13ef4710c..ea5dba87ae0006c 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 000000000000000..73d5077da3d9f18
--- /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 f9e592b493f5e51..af6c3bbefacf240 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 ->
+
>From 109df33fd4528dd1049544516949b46e214b72d3 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Tue, 7 Jan 2025 13:03:18 -0600
Subject: [PATCH 08/13] [flang][OpenMP] Semantic checks for context selectors
This implements checks of the validity of context set selectors and
trait selectors, plus the types of trait properties. Clause properties
are also validated, but not name or extension properties.
---
flang/include/flang/Parser/parse-tree.h | 2 +
.../flang/Semantics/openmp-modifiers.h | 1 +
flang/lib/Parser/parse-tree.cpp | 20 +
flang/lib/Semantics/check-omp-structure.cpp | 504 +++++++++++++++++-
flang/lib/Semantics/check-omp-structure.h | 26 +
flang/lib/Semantics/openmp-modifiers.cpp | 17 +
flang/test/Parser/OpenMP/metadirective.f90 | 14 +-
.../Semantics/OpenMP/metadirective-common.f90 | 37 ++
.../OpenMP/metadirective-construct.f90 | 33 ++
.../Semantics/OpenMP/metadirective-device.f90 | 36 ++
.../OpenMP/metadirective-implementation.f90 | 33 ++
.../Semantics/OpenMP/metadirective-user.f90 | 29 +
12 files changed, 743 insertions(+), 9 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/metadirective-common.f90
create mode 100644 flang/test/Semantics/OpenMP/metadirective-construct.f90
create mode 100644 flang/test/Semantics/OpenMP/metadirective-device.f90
create mode 100644 flang/test/Semantics/OpenMP/metadirective-implementation.f90
create mode 100644 flang/test/Semantics/OpenMP/metadirective-user.f90
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 71afb6d2ae75a7e..6053ad5dc0f7ada 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3569,6 +3569,7 @@ struct OmpTraitProperty {
// Trait-set-selectors:
// [D]evice, [T]arget_device, [C]onstruct, [I]mplementation, [U]ser.
struct OmpTraitSelectorName {
+ std::string ToString() const;
CharBlock source;
UNION_CLASS_BOILERPLATE(OmpTraitSelectorName);
ENUM_CLASS(Value, Arch, Atomic_Default_Mem_Order, Condition, Device_Num,
@@ -3593,6 +3594,7 @@ struct OmpTraitSelector {
// CONSTRUCT | DEVICE | IMPLEMENTATION | USER | // since 5.0
// TARGET_DEVICE // since 5.1
struct OmpTraitSetSelectorName {
+ std::string ToString() const;
CharBlock source;
ENUM_CLASS(Value, Construct, Device, Implementation, Target_Device, User)
WRAPPER_CLASS_BOILERPLATE(OmpTraitSetSelectorName, Value);
diff --git a/flang/include/flang/Semantics/openmp-modifiers.h b/flang/include/flang/Semantics/openmp-modifiers.h
index 5d5c5e97faf413b..7cdbf65adebe1c0 100644
--- a/flang/include/flang/Semantics/openmp-modifiers.h
+++ b/flang/include/flang/Semantics/openmp-modifiers.h
@@ -72,6 +72,7 @@ DECLARE_DESCRIPTOR(parser::OmpAlignModifier);
DECLARE_DESCRIPTOR(parser::OmpAllocatorComplexModifier);
DECLARE_DESCRIPTOR(parser::OmpAllocatorSimpleModifier);
DECLARE_DESCRIPTOR(parser::OmpChunkModifier);
+DECLARE_DESCRIPTOR(parser::OmpContextSelector);
DECLARE_DESCRIPTOR(parser::OmpDependenceType);
DECLARE_DESCRIPTOR(parser::OmpDeviceModifier);
DECLARE_DESCRIPTOR(parser::OmpDirectiveNameModifier);
diff --git a/flang/lib/Parser/parse-tree.cpp b/flang/lib/Parser/parse-tree.cpp
index a414f226058e3ed..251b6919cf52fed 100644
--- a/flang/lib/Parser/parse-tree.cpp
+++ b/flang/lib/Parser/parse-tree.cpp
@@ -281,6 +281,26 @@ OmpTaskDependenceType::Value OmpDependClause::TaskDep::GetTaskDepType() const {
}
}
+std::string OmpTraitSelectorName::ToString() const {
+ return common::visit( //
+ common::visitors{
+ [&](Value v) { //
+ return std::string(EnumToString(v));
+ },
+ [&](llvm::omp::Directive d) {
+ return llvm::omp::getOpenMPDirectiveName(d).str();
+ },
+ [&](const std::string &s) { //
+ return s;
+ },
+ },
+ u);
+}
+
+std::string OmpTraitSetSelectorName::ToString() const {
+ return std::string(EnumToString(v));
+}
+
} // namespace Fortran::parser
template <typename C> static llvm::omp::Clause getClauseIdForClass(C &&) {
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index d732233388d4fe3..94886d6b9dfdc9f 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -9,6 +9,8 @@
#include "check-omp-structure.h"
#include "definable.h"
#include "flang/Evaluate/check-expression.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Evaluate/type.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/expression.h"
#include "flang/Semantics/openmp-modifiers.h"
@@ -2921,7 +2923,6 @@ 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)
CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)
@@ -4468,14 +4469,513 @@ void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {
}
}
-void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctxSel) {
+void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
+ CheckAllowedClause(llvm::omp::Clause::OMPC_when);
+ OmpVerifyModifiers(
+ x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
+}
+
+void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctx) {
EnterDirectiveNest(ContextSelectorNest);
+
+ using SetName = parser::OmpTraitSetSelectorName;
+ std::map<SetName::Value, const SetName *> visited;
+
+ for (const parser::OmpTraitSetSelector &traitSet : ctx.v) {
+ auto &name{std::get<SetName>(traitSet.t)};
+ auto [prev, unique]{visited.insert(std::make_pair(name.v, &name))};
+ if (!unique) {
+ std::string showName{parser::ToUpperCaseLetters(name.ToString())};
+ parser::MessageFormattedText txt(
+ "Repeated trait set name %s in a context specifier"_err_en_US,
+ showName);
+ parser::Message message(name.source, txt);
+ message.Attach(prev->second->source,
+ "Previous trait set %s provided here"_en_US, showName);
+ context_.Say(std::move(message));
+ }
+ CheckTraitSetSelector(traitSet);
+ }
}
void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
ExitDirectiveNest(ContextSelectorNest);
}
+std::optional<evaluate::DynamicType> OmpStructureChecker::GetDynamicType(
+ const common::Indirection<parser::Expr> &parserExpr) {
+ // Indirection<parser::Expr> parserExpr
+ // `- parser::Expr ^.value()
+ const parser::TypedExpr &typedExpr{parserExpr.value().typedExpr};
+ // ForwardOwningPointer typedExpr
+ // `- GenericExprWrapper ^.get()
+ // `- std::optional<Expr> ^->v
+ if (auto maybeExpr{typedExpr.get()->v}) {
+ return maybeExpr->GetType();
+ } else {
+ return std::nullopt;
+ }
+}
+
+const std::list<parser::OmpTraitProperty> &
+OmpStructureChecker::GetTraitPropertyList(
+ const parser::OmpTraitSelector &trait) {
+ static const std::list<parser::OmpTraitProperty> empty{};
+ auto &[_, maybeProps]{trait.t};
+ if (maybeProps) {
+ using PropertyList = std::list<parser::OmpTraitProperty>;
+ return std::get<PropertyList>(maybeProps->t);
+ } else {
+ return empty;
+ }
+}
+
+std::optional<llvm::omp::Clause> OmpStructureChecker::GetClauseFromProperty(
+ const parser::OmpTraitProperty &property) {
+ using MaybeClause = std::optional<llvm::omp::Clause>;
+
+ // The parser for OmpClause will only succeed if the clause was
+ // given with all required arguments.
+ // If this is a string or complex extensiom with a clause name,
+ // treat it as a clause and let the trait checker deal with it.
+
+ auto getClauseFromString{[&](const std::string &s) -> MaybeClause {
+ auto id{llvm::omp::getOpenMPClauseKind(parser::ToLowerCaseLetters(s))};
+ if (id != llvm::omp::Clause::OMPC_unknown) {
+ return id;
+ } else {
+ return std::nullopt;
+ }
+ }};
+
+ return common::visit( //
+ common::visitors{
+ [&](const parser::OmpTraitPropertyName &x) -> MaybeClause {
+ return getClauseFromString(x.v);
+ },
+ [&](const common::Indirection<parser::OmpClause> &x) -> MaybeClause {
+ return x.value().Id();
+ },
+ [&](const parser::ScalarExpr &x) -> MaybeClause {
+ return std::nullopt;
+ },
+ [&](const parser::OmpTraitPropertyExtension &x) -> MaybeClause {
+ using ExtProperty = parser::OmpTraitPropertyExtension;
+ if (auto *name{std::get_if<parser::OmpTraitPropertyName>(&x.u)}) {
+ return getClauseFromString(name->v);
+ } else if (auto *cpx{std::get_if<ExtProperty::Complex>(&x.u)}) {
+ return getClauseFromString(
+ std::get<parser::OmpTraitPropertyName>(cpx->t).v);
+ }
+ return std::nullopt;
+ },
+ },
+ property.u);
+}
+
+void OmpStructureChecker::CheckTraitSelectorList(
+ const std::list<parser::OmpTraitSelector> &traits) {
+ // [6.0:322:20]
+ // Each trait-selector-name may only be specified once in a trait selector
+ // set.
+
+ // Cannot store OmpTraitSelectorName directly, because it's not copyable.
+ using TraitName = parser::OmpTraitSelectorName;
+ using BareName = decltype(TraitName::u);
+ std::map<BareName, const TraitName *> visited;
+
+ for (const parser::OmpTraitSelector &trait : traits) {
+ auto &name{std::get<TraitName>(trait.t)};
+
+ auto [prev, unique]{visited.insert(std::make_pair(name.u, &name))};
+ if (!unique) {
+ std::string showName{parser::ToUpperCaseLetters(name.ToString())};
+ parser::MessageFormattedText txt(
+ "Repeated trait name %s in a trait set"_err_en_US, showName);
+ parser::Message message(name.source, txt);
+ message.Attach(prev->second->source,
+ "Previous trait %s provided here"_en_US, showName);
+ context_.Say(std::move(message));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitSetSelector(
+ const parser::OmpTraitSetSelector &traitSet) {
+
+ // Trait Set | Allowed traits | D-traits | X-traits | Score |
+ //
+ // Construct | Simd, directive-name | Yes | No | No |
+ // Device | Arch, Isa, Kind | No | Yes | No |
+ // Implementation | Atomic_Default_Mem_Order | No | Yes | Yes |
+ // | Extension, Requires | | | |
+ // | Vendor | | | |
+ // Target_Device | Arch, Device_Num, Isa | No | Yes | No |
+ // | Kind, Uid | | | |
+ // User | Condition | No | No | Yes |
+
+ struct TraitSetConfig {
+ std::set<parser::OmpTraitSelectorName::Value> allowed;
+ bool allowsDirectiveTraits;
+ bool allowsExtensionTraits;
+ bool allowsScore;
+ };
+
+ using SName = parser::OmpTraitSetSelectorName::Value;
+ using TName = parser::OmpTraitSelectorName::Value;
+
+ static const std::map<SName, TraitSetConfig> configs{
+ {SName::Construct, //
+ {{TName::Simd}, true, false, false}},
+ {SName::Device, //
+ {{TName::Arch, TName::Isa, TName::Kind}, false, true, false}},
+ {SName::Implementation, //
+ {{TName::Atomic_Default_Mem_Order, TName::Extension, TName::Requires,
+ TName::Vendor},
+ false, true, true}},
+ {SName::Target_Device, //
+ {{TName::Arch, TName::Device_Num, TName::Isa, TName::Kind,
+ TName::Uid},
+ false, true, false}},
+ {SName::User, //
+ {{TName::Condition}, false, false, true}},
+ };
+
+ auto checkTraitSet{[&](const TraitSetConfig &config) {
+ auto &[setName, traits]{traitSet.t};
+ auto usn{parser::ToUpperCaseLetters(setName.ToString())};
+
+ // Check if there are any duplicate traits.
+ CheckTraitSelectorList(traits);
+
+ for (const parser::OmpTraitSelector &trait : traits) {
+ auto &[traitName, maybeProps]{trait.t};
+
+ // Check allowed traits
+ common::visit( //
+ common::visitors{
+ [&](parser::OmpTraitSelectorName::Value v) {
+ if (!config.allowed.count(v)) {
+ context_.Say(traitName.source,
+ "%s is not a valid trait for %s trait set"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()), usn);
+ }
+ },
+ [&](llvm::omp::Directive) {
+ if (!config.allowsDirectiveTraits) {
+ context_.Say(traitName.source,
+ "Directive name is not a valid trait for %s trait set"_err_en_US,
+ usn);
+ }
+ },
+ [&](const std::string &) {
+ if (!config.allowsExtensionTraits) {
+ context_.Say(traitName.source,
+ "Extension traits are not valid for %s trait set"_err_en_US,
+ usn);
+ }
+ },
+ },
+ traitName.u);
+
+ // Check score
+ if (maybeProps) {
+ auto &[maybeScore, _]{maybeProps->t};
+ if (maybeScore) {
+ CheckTraitScore(*maybeScore);
+ }
+ }
+
+ // Check the properties of the individual traits
+ CheckTraitSelector(traitSet, trait);
+ }
+ }};
+
+ checkTraitSet(
+ configs.at(std::get<parser::OmpTraitSetSelectorName>(traitSet.t).v));
+}
+
+void OmpStructureChecker::CheckTraitScore(const parser::OmpTraitScore &score) {
+ // [6.0:322:23]
+ // A score-expression must be a non-negative constant integer expression.
+ if (auto value{GetIntValue(score)}; !value || value <= 0) {
+ context_.Say(score.source,
+ "SCORE expression must be a non-negative constant integer expression"_err_en_US);
+ }
+}
+
+bool OmpStructureChecker::VerifyTraitPropertyLists(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ using TraitName = parser::OmpTraitSelectorName;
+ using PropertyList = std::list<parser::OmpTraitProperty>;
+ auto &[traitName, maybeProps]{trait.t};
+
+ auto checkPropertyList{[&](const PropertyList &properties, auto isValid,
+ const std::string &message) {
+ bool foundInvalid{false};
+ for (const parser::OmpTraitProperty &prop : properties) {
+ if (!isValid(prop)) {
+ if (foundInvalid) {
+ context_.Say(
+ prop.source, "More invalid properties are present"_err_en_US);
+ break;
+ }
+ context_.Say(prop.source, "%s"_err_en_US, message);
+ foundInvalid = true;
+ }
+ }
+ return !foundInvalid;
+ }};
+
+ bool invalid{false};
+
+ if (std::holds_alternative<llvm::omp::Directive>(traitName.u)) {
+ // Directive-name traits don't have properties.
+ if (maybeProps) {
+ context_.Say(trait.source,
+ "Directive-name traits cannot have properties"_err_en_US);
+ invalid = true;
+ }
+ }
+ // Ignore properties on extension traits.
+
+ // See `TraitSelectorParser` in openmp-parser.cpp
+ if (auto *v{std::get_if<TraitName::Value>(&traitName.u)}) {
+ switch (*v) {
+ // name-list properties
+ case parser::OmpTraitSelectorName::Value::Arch:
+ case parser::OmpTraitSelectorName::Value::Extension:
+ case parser::OmpTraitSelectorName::Value::Isa:
+ case parser::OmpTraitSelectorName::Value::Kind:
+ case parser::OmpTraitSelectorName::Value::Uid:
+ case parser::OmpTraitSelectorName::Value::Vendor:
+ if (maybeProps) {
+ auto isName{[](const parser::OmpTraitProperty &prop) {
+ return std::holds_alternative<parser::OmpTraitPropertyName>(prop.u);
+ }};
+ invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
+ isName, "Trait property should be a name");
+ }
+ break;
+ // clause-list
+ case parser::OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
+ case parser::OmpTraitSelectorName::Value::Requires:
+ case parser::OmpTraitSelectorName::Value::Simd:
+ if (maybeProps) {
+ auto isClause{[&](const parser::OmpTraitProperty &prop) {
+ return GetClauseFromProperty(prop).has_value();
+ }};
+ invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
+ isClause, "Trait property should be a clause");
+ }
+ break;
+ // expr-list
+ case parser::OmpTraitSelectorName::Value::Condition:
+ case parser::OmpTraitSelectorName::Value::Device_Num:
+ if (maybeProps) {
+ auto isExpr{[](const parser::OmpTraitProperty &prop) {
+ return std::holds_alternative<parser::ScalarExpr>(prop.u);
+ }};
+ invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
+ isExpr, "Trait property should be a scalar expression");
+ }
+ break;
+ } // switch
+ }
+
+ return !invalid;
+}
+
+void OmpStructureChecker::CheckTraitSelector(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ using TraitName = parser::OmpTraitSelectorName;
+ auto &[traitName, maybeProps]{trait.t};
+
+ // Only do the detailed checks if the property lists are valid.
+ if (VerifyTraitPropertyLists(traitSet, trait)) {
+ if (std::holds_alternative<llvm::omp::Directive>(traitName.u) ||
+ std::holds_alternative<std::string>(traitName.u)) {
+ // No properties here: directives don't have properties, and
+ // we don't implement any extension traits now.
+ return;
+ }
+
+ // Specific traits we want to check.
+ // Limitations:
+ // (1) The properties for these traits are defined in "Additional
+ // Definitions for the OpenMP API Specification". It's not clear how
+ // to define them in a portable way, and how to verify their validity,
+ // especially if they get replaced by their integer values (in case
+ // they are defined as enums).
+ // (2) These are entirely implementation-defined, and at the moment
+ // there is no known schema to validate these values.
+ auto v{std::get<TraitName::Value>(traitName.u)};
+ switch (v) {
+ case TraitName::Value::Arch:
+ // Unchecked, TBD(1)
+ break;
+ case TraitName::Value::Atomic_Default_Mem_Order:
+ CheckTraitADMO(traitSet, trait);
+ break;
+ case TraitName::Value::Condition:
+ CheckTraitCondition(traitSet, trait);
+ break;
+ case TraitName::Value::Device_Num:
+ CheckTraitDeviceNum(traitSet, trait);
+ break;
+ case TraitName::Value::Extension:
+ // Ignore
+ break;
+ case TraitName::Value::Isa:
+ // Unchecked, TBD(1)
+ break;
+ case TraitName::Value::Kind:
+ // Unchecked, TBD(1)
+ break;
+ case TraitName::Value::Requires:
+ CheckTraitRequires(traitSet, trait);
+ break;
+ case TraitName::Value::Simd:
+ CheckTraitSimd(traitSet, trait);
+ break;
+ case TraitName::Value::Uid:
+ // Unchecked, TBD(2)
+ break;
+ case TraitName::Value::Vendor:
+ // Unchecked, TBD(1)
+ break;
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitADMO(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ if (properties.size() != 1) {
+ context_.Say(trait.source,
+ "%s trait requires a single clause property"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ } else {
+ const parser::OmpTraitProperty &property{properties.front()};
+ auto clauseId{*GetClauseFromProperty(property)};
+ // Check that the clause belongs to the memory-order clause-set.
+ // Clause sets will hopefully be autogenerated at some point.
+ switch (clauseId) {
+ case llvm::omp::Clause::OMPC_acq_rel:
+ case llvm::omp::Clause::OMPC_acquire:
+ case llvm::omp::Clause::OMPC_relaxed:
+ case llvm::omp::Clause::OMPC_release:
+ case llvm::omp::Clause::OMPC_seq_cst:
+ break;
+ default:
+ context_.Say(property.source,
+ "%s trait requires a clause from the memory-order clause set"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+
+ using ClauseProperty = common::Indirection<parser::OmpClause>;
+ if (!std::holds_alternative<ClauseProperty>(property.u)) {
+ context_.Say(property.source,
+ "Invalid clause specification for %s"_err_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clauseId)));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitCondition(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ if (properties.size() != 1) {
+ context_.Say(trait.source,
+ "%s trait requires a single expression property"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ } else {
+ const parser::OmpTraitProperty &property{properties.front()};
+ auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
+
+ auto maybeType{GetDynamicType(scalarExpr.thing)};
+ if (!maybeType || maybeType->category() != TypeCategory::Logical) {
+ context_.Say(property.source,
+ "%s trait requires a single LOGICAL expression"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitDeviceNum(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ if (properties.size() != 1) {
+ context_.Say(trait.source,
+ "%s trait requires a single expression property"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+ // No other checks at the moment.
+}
+
+void OmpStructureChecker::CheckTraitRequires(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ unsigned version{context_.langOptions().OpenMPVersion};
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ for (const parser::OmpTraitProperty &property : properties) {
+ auto clauseId{*GetClauseFromProperty(property)};
+ if (!llvm::omp::isAllowedClauseForDirective(
+ llvm::omp::OMPD_requires, clauseId, version)) {
+ context_.Say(property.source,
+ "%s trait requires a clause from the requirement clause set"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()));
+ }
+
+ using ClauseProperty = common::Indirection<parser::OmpClause>;
+ if (!std::holds_alternative<ClauseProperty>(property.u)) {
+ context_.Say(property.source,
+ "Invalid clause specification for %s"_err_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clauseId)));
+ }
+ }
+}
+
+void OmpStructureChecker::CheckTraitSimd(
+ const parser::OmpTraitSetSelector &traitSet,
+ const parser::OmpTraitSelector &trait) {
+ unsigned version{context_.langOptions().OpenMPVersion};
+ auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
+ auto &properties{GetTraitPropertyList(trait)};
+
+ for (const parser::OmpTraitProperty &property : properties) {
+ auto clauseId{*GetClauseFromProperty(property)};
+ if (!llvm::omp::isAllowedClauseForDirective(
+ llvm::omp::OMPD_declare_simd, clauseId, version)) {
+ context_.Say(property.source,
+ "%s trait requires a clause that is allowed on the %s directive"_err_en_US,
+ parser::ToUpperCaseLetters(traitName.ToString()),
+ parser::ToUpperCaseLetters(
+ getDirectiveName(llvm::omp::OMPD_declare_simd)));
+ }
+
+ using ClauseProperty = common::Indirection<parser::OmpClause>;
+ if (!std::holds_alternative<ClauseProperty>(property.u)) {
+ context_.Say(property.source,
+ "Invalid clause specification for %s"_err_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clauseId)));
+ }
+ }
+}
+
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 da62264b62571d1..107e1fd16ab19bb 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -182,6 +182,32 @@ class OmpStructureChecker
// specific clause related
void CheckAllowedMapTypes(const parser::OmpMapType::Value &,
const std::list<parser::OmpMapType::Value> &);
+
+ std::optional<evaluate::DynamicType> GetDynamicType(
+ const common::Indirection<parser::Expr> &);
+ const std::list<parser::OmpTraitProperty> &GetTraitPropertyList(
+ const parser::OmpTraitSelector &);
+ std::optional<llvm::omp::Clause> GetClauseFromProperty(
+ const parser::OmpTraitProperty &);
+
+ void CheckTraitSelectorList(const std::list<parser::OmpTraitSelector> &);
+ void CheckTraitSetSelector(const parser::OmpTraitSetSelector &);
+ void CheckTraitScore(const parser::OmpTraitScore &);
+ bool VerifyTraitPropertyLists(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+ void CheckTraitSelector(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+ void CheckTraitADMO(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+ void CheckTraitCondition(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+ void CheckTraitDeviceNum(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+ void CheckTraitRequires(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+ void CheckTraitSimd(const parser::OmpTraitSetSelector &,
+ const parser::OmpTraitSelector &);
+
llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
diff --git a/flang/lib/Semantics/openmp-modifiers.cpp b/flang/lib/Semantics/openmp-modifiers.cpp
index 9f2896229bb7ff6..73ad7751ee51746 100644
--- a/flang/lib/Semantics/openmp-modifiers.cpp
+++ b/flang/lib/Semantics/openmp-modifiers.cpp
@@ -156,6 +156,23 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpChunkModifier>() {
return desc;
}
+template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpContextSelector>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"context-selector",
+ /*props=*/
+ {
+ {50, {OmpProperty::Required, OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ // The MATCH clause takes a selector as an argument, not modifier.
+ {50, {Clause::OMPC_when}},
+ },
+ };
+ return desc;
+}
+
template <>
const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpDependenceType>() {
static const OmpModifierDescriptor desc{
diff --git a/flang/test/Parser/OpenMP/metadirective.f90 b/flang/test/Parser/OpenMP/metadirective.f90
index af6c3bbefacf240..359f0d8be7a65e6 100644
--- a/flang/test/Parser/OpenMP/metadirective.f90
+++ b/flang/test/Parser/OpenMP/metadirective.f90
@@ -22,17 +22,17 @@ subroutine f00
!PARSE-TREE: | | | OmpClauseList ->
subroutine f01
- !$omp metadirective when(device={kind(host), device_num(1)}: nothing)
+ !$omp metadirective when(target_device={kind(host), device_num(1)}: nothing)
end
!UNPARSE: SUBROUTINE f01
-!UNPARSE: !$OMP METADIRECTIVE WHEN(DEVICE={KIND(host), DEVICE_NUM(1_4)}: NOTHING)
+!UNPARSE: !$OMP METADIRECTIVE WHEN(TARGET_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: | | | OmpTraitSetSelectorName -> Value = Target_Device
!PARSE-TREE: | | | OmpTraitSelector
!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Kind
!PARSE-TREE: | | | | Properties
@@ -95,12 +95,12 @@ subroutine f03
subroutine f04
!$omp metadirective &
- !$omp & when(implementation={extension(haha(1), foo(baz, "bar"(1)))}: nothing)
+ !$omp when(implementation={extension_trait(haha(1), foo(baz, "bar"(1)))}: nothing)
end
!UNPARSE: SUBROUTINE f04
-!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={EXTENSION(haha(1_4), foo(baz,bar(1_4)))}: &
-!UNPARSE: !$OMP&NOTHING)
+!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={extension_trait(haha(1_4), foo(baz,bar(1_4&
+!UNPARSE: !$OMP&)))}: NOTHING)
!UNPARSE: END SUBROUTINE
!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
@@ -108,7 +108,7 @@ subroutine f04
!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = Implementation
!PARSE-TREE: | | | OmpTraitSelector
-!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Extension
+!PARSE-TREE: | | | | OmpTraitSelectorName -> string = 'extension_trait'
!PARSE-TREE: | | | | Properties
!PARSE-TREE: | | | | | OmpTraitProperty -> OmpTraitPropertyExtension -> Complex
!PARSE-TREE: | | | | | | OmpTraitPropertyName -> string = 'haha'
diff --git a/flang/test/Semantics/OpenMP/metadirective-common.f90 b/flang/test/Semantics/OpenMP/metadirective-common.f90
new file mode 100644
index 000000000000000..4988fae9e8edca3
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-common.f90
@@ -0,0 +1,37 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=52
+
+! Common context selector tests
+
+subroutine f00
+ !$omp metadirective &
+ !$omp & when(implementation={vendor("this")}, &
+!ERROR: Repeated trait set name IMPLEMENTATION in a context specifier
+ !$omp & implementation={requires(unified_shared_memory)}: nothing)
+end
+
+subroutine f01
+ !$omp metadirective &
+!ERROR: Repeated trait name ISA in a trait set
+ !$omp & when(device={isa("this"), isa("that")}: nothing)
+end
+
+subroutine f02
+ !$omp metadirective &
+!ERROR: SCORE expression must be a non-negative constant integer expression
+ !$omp & when(user={condition(score(-2): .true.)}: nothing)
+end
+
+subroutine f03(x)
+ integer :: x
+ !$omp metadirective &
+!ERROR: SCORE expression must be a non-negative constant integer expression
+ !$omp & when(user={condition(score(x): .true.)}: nothing)
+end
+
+subroutine f04
+ !$omp metadirective &
+!ERROR: Trait property should be a scalar expression
+!ERROR: More invalid properties are present
+ !$omp & when(target_device={device_num("device", "foo"(1))}: nothing)
+end
+
diff --git a/flang/test/Semantics/OpenMP/metadirective-construct.f90 b/flang/test/Semantics/OpenMP/metadirective-construct.f90
new file mode 100644
index 000000000000000..1dd23b1dca67b62
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-construct.f90
@@ -0,0 +1,33 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=52
+
+! The CONSTRUCT trait set
+
+subroutine f00
+ !$omp metadirective &
+!ERROR: CONDITION is not a valid trait for CONSTRUCT trait set
+ !$omp & when(construct={condition(.true.)}: nothing)
+end
+
+subroutine f01
+ !$omp metadirective &
+!ERROR: Directive-name traits cannot have properties
+ !$omp & when(construct={parallel(nowait), simd}: nothing)
+end
+
+subroutine f02
+ !$omp metadirective &
+!ERROR: SIMD trait requires a clause that is allowed on the DECLARE SIMD directive
+ !$omp & when(construct={simd(nowait)}: nothing)
+end
+
+subroutine f03
+ !$omp metadirective &
+!ERROR: Extension traits are not valid for CONSTRUCT trait set
+ !$omp & when(construct={fred(1)}: nothing)
+end
+
+subroutine f04
+ !$omp metadirective &
+!This is ok
+ !$omp & when(construct={parallel, simd(simdlen(32), notinbranch)}: nothing)
+end
diff --git a/flang/test/Semantics/OpenMP/metadirective-device.f90 b/flang/test/Semantics/OpenMP/metadirective-device.f90
new file mode 100644
index 000000000000000..fb114990662477c
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-device.f90
@@ -0,0 +1,36 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=52
+
+! The DEVICE and TARGET_DEVICE trait sets
+
+subroutine f00
+ !$omp metadirective &
+!ERROR: DEVICE_NUM is not a valid trait for DEVICE trait set
+ !$omp & when(device={device_num(10)}: nothing)
+end
+
+subroutine f01
+ !$omp metadirective &
+!This is ok: all traits are valid
+ !$omp & when(device={arch("some-arch"), isa("some-isa"), kind("some-kind")}:&
+ !$omp & nothing)
+end
+
+subroutine f02
+ !$omp metadirective &
+!This is ok: all traits are valid
+ !$omp & when(target_device={arch("some-arch"), device_num(10), &
+ !$omp & isa("some-isa"), kind("some-kind"), uid("some-uid")}: nothing)
+end
+
+subroutine f03
+ !$omp metadirective &
+!This is ok: extension traits are allowed
+ !$omp & when(device={some_new_trait}: nothing)
+end
+
+subroutine f04
+ !$omp metadirective &
+!This is ok: extension traits are allowed
+ !$omp & when(target_device={another_new_trait(12, 21)}: nothing)
+end
+
diff --git a/flang/test/Semantics/OpenMP/metadirective-implementation.f90 b/flang/test/Semantics/OpenMP/metadirective-implementation.f90
new file mode 100644
index 000000000000000..7a7642158fc29fa
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-implementation.f90
@@ -0,0 +1,33 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=52
+
+! The IMPLEMENTATION trait set
+
+subroutine f00
+ !$omp metadirective &
+!ERROR: Trait property should be a clause
+ !$omp & when(implementation={atomic_default_mem_order(0)}: nothing)
+end
+
+subroutine f01
+ !$omp metadirective &
+!ERROR: ATOMIC_DEFAULT_MEM_ORDER trait requires a clause from the memory-order clause set
+ !$omp & when(implementation={atomic_default_mem_order(nowait)}: nothing)
+end
+
+subroutine f02
+ !$omp metadirective &
+!ERROR: REQUIRES trait requires a clause from the requirement clause set
+!ERROR: Invalid clause specification for SHARED
+ !$omp & when(implementation={requires(shared)}: nothing)
+end
+
+subroutine f03
+ !$omp metadirective &
+!This is ok
+ !$omp & when(implementation={ &
+ !$omp & atomic_default_mem_order(relaxed), &
+ !$omp & extension("foo"), &
+ !$omp & requires(unified_address),
+ !$omp & vendor(some_vendor) &
+ !$omp & }: nothing)
+end
diff --git a/flang/test/Semantics/OpenMP/metadirective-user.f90 b/flang/test/Semantics/OpenMP/metadirective-user.f90
new file mode 100644
index 000000000000000..c4f037d57a9d940
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/metadirective-user.f90
@@ -0,0 +1,29 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=52
+
+! The USER trait set
+
+subroutine f00(x)
+ integer :: x
+ !$omp metadirective &
+!ERROR: CONDITION trait requires a single LOGICAL expression
+ !$omp & when(user={condition(score(2): x)}: nothing)
+end
+
+subroutine f01
+ !$omp metadirective &
+!ERROR: CONDITION trait requires a single expression property
+ !$omp & when(user={condition(.true., .false.)}: nothing)
+end
+
+subroutine f02
+ !$omp metadirective &
+!ERROR: Extension traits are not valid for USER trait set
+ !$omp & when(user={fred}: nothing)
+end
+
+subroutine f03(x)
+ integer :: x
+ !$omp metadirective &
+!This is ok
+ !$omp & when(user={condition(x > 0)}: nothing)
+end
>From 14fe4f270a7bd5ec3912d476677fe9169025712a Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 16 Jan 2025 16:53:48 -0600
Subject: [PATCH 09/13] format
---
flang/lib/Semantics/check-omp-structure.h | 30 +++++++++++------------
1 file changed, 15 insertions(+), 15 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 107e1fd16ab19bb..7761902d0bf9bac 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -188,25 +188,25 @@ class OmpStructureChecker
const std::list<parser::OmpTraitProperty> &GetTraitPropertyList(
const parser::OmpTraitSelector &);
std::optional<llvm::omp::Clause> GetClauseFromProperty(
- const parser::OmpTraitProperty &);
+ const parser::OmpTraitProperty &);
void CheckTraitSelectorList(const std::list<parser::OmpTraitSelector> &);
void CheckTraitSetSelector(const parser::OmpTraitSetSelector &);
void CheckTraitScore(const parser::OmpTraitScore &);
- bool VerifyTraitPropertyLists(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
- void CheckTraitSelector(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
- void CheckTraitADMO(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
- void CheckTraitCondition(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
- void CheckTraitDeviceNum(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
- void CheckTraitRequires(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
- void CheckTraitSimd(const parser::OmpTraitSetSelector &,
- const parser::OmpTraitSelector &);
+ bool VerifyTraitPropertyLists(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
+ void CheckTraitSelector(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
+ void CheckTraitADMO(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
+ void CheckTraitCondition(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
+ void CheckTraitDeviceNum(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
+ void CheckTraitRequires(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
+ void CheckTraitSimd(
+ const parser::OmpTraitSetSelector &, const parser::OmpTraitSelector &);
llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
>From 7fa026c6561020669f42b94fb474648f59fb1e7a Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Fri, 17 Jan 2025 15:04:52 -0600
Subject: [PATCH 10/13] [flang][OpenMP] Parse METADIRECTIVE in specification
part
Add METADIRECTIVE to the OpenMP declarative constructs as well. Emit
a TODO error for both declarative and executable cases.
---
flang/include/flang/Parser/parse-tree.h | 4 +-
flang/lib/Lower/OpenMP/OpenMP.cpp | 12 +++--
flang/lib/Parser/openmp-parsers.cpp | 4 +-
.../Lower/OpenMP/Todo/metadirective-exec.f90 | 9 ++++
.../Lower/OpenMP/Todo/metadirective-spec.f90 | 9 ++++
.../test/Parser/OpenMP/metadirective-v50.f90 | 2 +
flang/test/Parser/OpenMP/metadirective.f90 | 53 +++++++++++++++++++
7 files changed, 85 insertions(+), 8 deletions(-)
create mode 100644 flang/test/Lower/OpenMP/Todo/metadirective-exec.f90
create mode 100644 flang/test/Lower/OpenMP/Todo/metadirective-spec.f90
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 6053ad5dc0f7ada..2e27b6ea7eafa14 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -4537,8 +4537,8 @@ struct OpenMPDeclarativeConstruct {
CharBlock source;
std::variant<OpenMPDeclarativeAllocate, OpenMPDeclareMapperConstruct,
OpenMPDeclareReductionConstruct, OpenMPDeclareSimdConstruct,
- OpenMPDeclareTargetConstruct, OpenMPThreadprivate,
- OpenMPRequiresConstruct, OpenMPUtilityConstruct>
+ OpenMPThreadprivate, OpenMPRequiresConstruct, OpenMPUtilityConstruct,
+ OpenMPDeclareTargetConstruct, OmpMetadirectiveDirective>
u;
};
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 3a4336fe5b90f9b..debab2352abd0a9 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -3137,6 +3137,13 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
// support the case of threadprivate variable declared in module.
}
+static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
+ semantics::SemanticsContext &semaCtx,
+ lower::pft::Evaluation &eval,
+ const parser::OmpMetadirectiveDirective &meta) {
+ TODO(converter.getCurrentLocation(), "METADIRECTIVE");
+}
+
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx,
lower::pft::Evaluation &eval,
@@ -3229,11 +3236,6 @@ 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 e3c9292bc5f91e3..f5387dcf4b3c3df 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -1283,7 +1283,9 @@ TYPE_PARSER(startOmpLine >>
construct<OpenMPDeclarativeConstruct>(
Parser<OpenMPThreadprivate>{}) ||
construct<OpenMPDeclarativeConstruct>(
- Parser<OpenMPUtilityConstruct>{})) /
+ Parser<OpenMPUtilityConstruct>{}) ||
+ construct<OpenMPDeclarativeConstruct>(
+ Parser<OmpMetadirectiveDirective>{})) /
endOmpLine))
// Block Construct
diff --git a/flang/test/Lower/OpenMP/Todo/metadirective-exec.f90 b/flang/test/Lower/OpenMP/Todo/metadirective-exec.f90
new file mode 100644
index 000000000000000..2e160a18966162f
--- /dev/null
+++ b/flang/test/Lower/OpenMP/Todo/metadirective-exec.f90
@@ -0,0 +1,9 @@
+!RUN: %not_todo_cmd bbc -emit-hlfir -fopenmp -fopenmp-version=52 -o - %s 2>&1 | FileCheck %s
+!RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=52 -o - %s 2>&1 | FileCheck %s
+
+!CHECK: not yet implemented: METADIRECTIVE
+subroutine f00
+ continue
+ !Executable
+ !$omp metadirective when(user={condition(.true.)}: nothing)
+end
diff --git a/flang/test/Lower/OpenMP/Todo/metadirective-spec.f90 b/flang/test/Lower/OpenMP/Todo/metadirective-spec.f90
new file mode 100644
index 000000000000000..a00612a92218a28
--- /dev/null
+++ b/flang/test/Lower/OpenMP/Todo/metadirective-spec.f90
@@ -0,0 +1,9 @@
+!RUN: %not_todo_cmd bbc -emit-hlfir -fopenmp -fopenmp-version=52 -o - %s 2>&1 | FileCheck %s
+!RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=52 -o - %s 2>&1 | FileCheck %s
+
+!CHECK: not yet implemented: METADIRECTIVE
+subroutine f00
+ !Specification
+ !$omp metadirective when(user={condition(.true.)}: nothing)
+ implicit none
+end
diff --git a/flang/test/Parser/OpenMP/metadirective-v50.f90 b/flang/test/Parser/OpenMP/metadirective-v50.f90
index 73d5077da3d9f18..d7c3121b8f1b80b 100644
--- a/flang/test/Parser/OpenMP/metadirective-v50.f90
+++ b/flang/test/Parser/OpenMP/metadirective-v50.f90
@@ -2,12 +2,14 @@
!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=50 %s | FileCheck --check-prefix="PARSE-TREE" %s
subroutine f01
+ continue
!$omp metadirective &
!$omp & when(user={condition(.true.)}: nothing) &
!$omp & default(nothing)
end
!UNPARSE: SUBROUTINE f01
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: NOTHING) DEFAULT(NOTHING)
!UNPARSE: END SUBROUTINE
diff --git a/flang/test/Parser/OpenMP/metadirective.f90 b/flang/test/Parser/OpenMP/metadirective.f90
index 359f0d8be7a65e6..4da5c05e65f3591 100644
--- a/flang/test/Parser/OpenMP/metadirective.f90
+++ b/flang/test/Parser/OpenMP/metadirective.f90
@@ -2,10 +2,12 @@
!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=52 %s | FileCheck --check-prefix="PARSE-TREE" %s
subroutine f00
+ continue
!$omp metadirective when(construct={target, parallel}: nothing)
end
!UNPARSE: SUBROUTINE f00
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(CONSTRUCT={TARGET, PARALLEL}: NOTHING)
!UNPARSE: END SUBROUTINE
@@ -22,10 +24,12 @@ subroutine f00
!PARSE-TREE: | | | OmpClauseList ->
subroutine f01
+ continue
!$omp metadirective when(target_device={kind(host), device_num(1)}: nothing)
end
!UNPARSE: SUBROUTINE f01
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(TARGET_DEVICE={KIND(host), DEVICE_NUM(1_4)}: NOTHING)
!UNPARSE: END SUBROUTINE
@@ -47,10 +51,12 @@ subroutine f01
!PARSE-TREE: | | | OmpClauseList ->
subroutine f02
+ continue
!$omp metadirective when(target_device={kind(any), device_num(7)}: nothing)
end
!UNPARSE: SUBROUTINE f02
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(TARGET_DEVICE={KIND(any), DEVICE_NUM(7_4)}: NOTHING)
!UNPARSE: END SUBROUTINE
@@ -72,11 +78,13 @@ subroutine f02
!PARSE-TREE: | | | OmpClauseList ->
subroutine f03
+ continue
!$omp metadirective &
!$omp & when(implementation={atomic_default_mem_order(acq_rel)}: nothing)
end
!UNPARSE: SUBROUTINE f03
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={ATOMIC_DEFAULT_MEM_ORDER(ACQ_REL)}: &
!UNPARSE: !$OMP&NOTHING)
!UNPARSE: END SUBROUTINE
@@ -94,11 +102,13 @@ subroutine f03
!PARSE-TREE: | | | OmpClauseList ->
subroutine f04
+ continue
!$omp metadirective &
!$omp when(implementation={extension_trait(haha(1), foo(baz, "bar"(1)))}: nothing)
end
!UNPARSE: SUBROUTINE f04
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={extension_trait(haha(1_4), foo(baz,bar(1_4&
!UNPARSE: !$OMP&)))}: NOTHING)
!UNPARSE: END SUBROUTINE
@@ -127,6 +137,7 @@ subroutine f04
subroutine f05(x)
integer :: x
+ continue
!$omp metadirective &
!$omp & when(user={condition(score(100): .true.)}: &
!$omp & parallel do reduction(+: x)) &
@@ -137,6 +148,7 @@ subroutine f05(x)
!UNPARSE: SUBROUTINE f05 (x)
!UNPARSE: INTEGER x
+!UNPARSE: CONTINUE
!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
@@ -165,6 +177,7 @@ subroutine f05(x)
!PARSE-TREE: | | OmpClauseList ->
subroutine f06
+ continue
! Two trait set selectors
!$omp metadirective &
!$omp & when(implementation={vendor("amd")}, &
@@ -172,6 +185,7 @@ subroutine f06
end
!UNPARSE: SUBROUTINE f06
+!UNPARSE: CONTINUE
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={VENDOR(amd)}, USER={CONDITION(.true._4)}: NO&
!UNPARSE: !$OMP&THING)
!UNPARSE: END SUBROUTINE
@@ -196,3 +210,42 @@ subroutine f06
!PARSE-TREE: | | | llvm::omp::Directive = nothing
!PARSE-TREE: | | | OmpClauseList ->
+subroutine f07
+ ! Declarative metadirective
+ !$omp metadirective &
+ !$omp & when(implementation={vendor("amd")}: declare simd) &
+ !$omp & when(user={condition(.true.)}: declare target) &
+ !$omp & otherwise(nothing)
+end
+
+!UNPARSE: SUBROUTINE f07
+!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={VENDOR(amd)}: DECLARE SIMD) WHEN(USE&
+!UNPARSE: !$OMP&R={CONDITION(.true._4)}: DECLARE TARGET) OTHERWISE(NOTHING)
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: OpenMPDeclarativeConstruct -> 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: | | OmpDirectiveSpecification
+!PARSE-TREE: | | | llvm::omp::Directive = declare simd
+!PARSE-TREE: | | | OmpClauseList ->
+!PARSE-TREE: | 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 = declare target
+!PARSE-TREE: | | | OmpClauseList ->
+!PARSE-TREE: | OmpClause -> Otherwise -> OmpOtherwiseClause -> OmpDirectiveSpecification
+!PARSE-TREE: | | llvm::omp::Directive = nothing
+!PARSE-TREE: | | OmpClauseList ->
>From 7c2a3be3b02f39d68074646f4bc82c08e049e347 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Sat, 18 Jan 2025 09:17:51 -0600
Subject: [PATCH 11/13] fix example
---
flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp b/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp
index c78dd7f14e503d6..b0a632247fe105c 100644
--- a/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp
+++ b/flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp
@@ -112,6 +112,10 @@ std::string OpenMPCounterVisitor::getName(const OpenMPDeclarativeConstruct &c) {
const CharBlock &source{o.source};
return normalize_construct_name(source.ToString());
},
+ [&](const OmpMetadirectiveDirective &o) -> std::string {
+ const CharBlock &source{o.source};
+ return normalize_construct_name(source.ToString());
+ },
[&](const auto &o) -> std::string {
const CharBlock &source{std::get<Verbatim>(o.t).source};
return normalize_construct_name(source.ToString());
>From e230e8ad3bcd09fc28b18f64a84fcd20d6e9bc65 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Wed, 22 Jan 2025 09:47:44 -0600
Subject: [PATCH 12/13] [flang][OpenMP] Handle directive arguments in
OmpDirectiveSpecifier
Implement parsing and symbol resolution for directives that take
arguments. There are a few, and most of them take objects. Special
handling is needed for two that take more specialized arguments:
DECLARE MAPPER and DECLARE REDUCTION.
This only affects directives in METADIRECTIVE's WHEN and OTHERWISE
clauses. Parsing and semantic checks of other cases is unaffected.
---
flang/examples/FeatureList/FeatureList.cpp | 1 -
flang/include/flang/Parser/dump-parse-tree.h | 9 +-
flang/include/flang/Parser/parse-tree.h | 142 ++++++----
flang/lib/Parser/openmp-parsers.cpp | 68 +++--
flang/lib/Parser/unparse.cpp | 40 +--
flang/lib/Semantics/check-omp-structure.cpp | 2 +-
flang/lib/Semantics/resolve-names.cpp | 130 +++++++---
.../Parser/OpenMP/declare-mapper-unparse.f90 | 4 +-
.../Parser/OpenMP/metadirective-dirspec.f90 | 242 ++++++++++++++++++
9 files changed, 517 insertions(+), 121 deletions(-)
create mode 100644 flang/test/Parser/OpenMP/metadirective-dirspec.f90
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 3a689c335c81c08..e35f120d8661ea1 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/flang/examples/FeatureList/FeatureList.cpp
@@ -514,7 +514,6 @@ struct NodeVisitor {
READ_FEATURE(OmpReductionClause)
READ_FEATURE(OmpInReductionClause)
READ_FEATURE(OmpReductionCombiner)
- READ_FEATURE(OmpReductionCombiner::FunctionCombiner)
READ_FEATURE(OmpReductionInitializerClause)
READ_FEATURE(OmpReductionIdentifier)
READ_FEATURE(OmpAllocateClause)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 1323fd695d44393..ce518c7c3edea04 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, OmpTypeSpecifier)
+ NODE(parser, OmpTypeNameList)
+ NODE(parser, OmpLocator)
+ NODE(parser, OmpLocatorList)
+ NODE(parser, OmpReductionSpecifier)
+ NODE(parser, OmpArgument)
NODE(parser, OmpMetadirectiveDirective)
NODE(parser, OmpMatchClause)
NODE(parser, OmpOtherwiseClause)
@@ -541,7 +547,7 @@ class ParseTreeDumper {
NODE(parser, OmpDeclareTargetSpecifier)
NODE(parser, OmpDeclareTargetWithClause)
NODE(parser, OmpDeclareTargetWithList)
- NODE(parser, OmpDeclareMapperSpecifier)
+ NODE(parser, OmpMapperSpecifier)
NODE(parser, OmpDefaultClause)
NODE_ENUM(OmpDefaultClause, DataSharingAttribute)
NODE(parser, OmpVariableCategory)
@@ -624,7 +630,6 @@ class ParseTreeDumper {
NODE(parser, OmpReductionCombiner)
NODE(parser, OmpTaskReductionClause)
NODE(OmpTaskReductionClause, Modifier)
- NODE(OmpReductionCombiner, FunctionCombiner)
NODE(parser, OmpReductionInitializerClause)
NODE(parser, OmpReductionIdentifier)
NODE(parser, OmpAllocateClause)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 2e27b6ea7eafa14..993c1338f7235b8 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3454,15 +3454,7 @@ WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
// --- Common definitions
struct OmpClause;
-struct OmpClauseList;
-
-struct OmpDirectiveSpecification {
- TUPLE_CLASS_BOILERPLATE(OmpDirectiveSpecification);
- std::tuple<llvm::omp::Directive,
- std::optional<common::Indirection<OmpClauseList>>>
- t;
- CharBlock source;
-};
+struct OmpDirectiveSpecification;
// 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
@@ -3475,15 +3467,76 @@ struct OmpObject {
WRAPPER_CLASS(OmpObjectList, std::list<OmpObject>);
-#define MODIFIER_BOILERPLATE(...) \
- struct Modifier { \
- using Variant = std::variant<__VA_ARGS__>; \
- UNION_CLASS_BOILERPLATE(Modifier); \
- CharBlock source; \
- Variant u; \
- }
+// Ref: [4.5:201-207], [5.0:293-299], [5.1:325-331], [5.2:124]
+//
+// reduction-identifier ->
+// base-language-identifier | // since 4.5
+// - | // since 4.5, until 5.2
+// + | * | .AND. | .OR. | .EQV. | .NEQV. | // since 4.5
+// MIN | MAX | IAND | IOR | IEOR // since 4.5
+struct OmpReductionIdentifier {
+ UNION_CLASS_BOILERPLATE(OmpReductionIdentifier);
+ std::variant<DefinedOperator, ProcedureDesignator> u;
+};
-#define MODIFIERS() std::optional<std::list<Modifier>>
+// Ref: [4.5:222:6], [5.0:305:27], [5.1:337:19], [5.2:126:3-4], [6.0:240:27-28]
+//
+// combiner-expression -> // since 4.5
+// assignment-statement |
+// function-reference
+struct OmpReductionCombiner {
+ UNION_CLASS_BOILERPLATE(OmpReductionCombiner);
+ std::variant<AssignmentStmt, FunctionReference> u;
+};
+
+inline namespace arguments {
+struct OmpTypeSpecifier {
+ UNION_CLASS_BOILERPLATE(OmpTypeSpecifier);
+ std::variant<TypeSpec, DeclarationTypeSpec> u;
+};
+
+WRAPPER_CLASS(OmpTypeNameList, std::list<OmpTypeSpecifier>);
+
+struct OmpLocator {
+ UNION_CLASS_BOILERPLATE(OmpLocator);
+ std::variant<OmpObject, FunctionReference> u;
+};
+
+WRAPPER_CLASS(OmpLocatorList, std::list<OmpLocator>);
+
+// Ref: [5.0:326:10-16], [5.1:359:5-11], [5.2:163:2-7], [6.0:293:16-21]
+//
+// mapper-specifier ->
+// [mapper-identifier :] type :: var | // since 5.0
+// DEFAULT type :: var
+struct OmpMapperSpecifier {
+ // Absent mapper-identifier is equivalent to DEFAULT.
+ TUPLE_CLASS_BOILERPLATE(OmpMapperSpecifier);
+ std::tuple<std::optional<Name>, TypeSpec, Name> t;
+};
+
+// Ref: [4.5:222:1-5], [5.0:305:20-27], [5.1:337:11-19], [5.2:139:18-23],
+// [6.0:260:16-20]
+//
+// reduction-specifier ->
+// reduction-identifier : typename-list
+// : combiner-expression // since 4.5, until 5.2
+// reduction-identifier : typename-list // since 6.0
+struct OmpReductionSpecifier {
+ TUPLE_CLASS_BOILERPLATE(OmpReductionSpecifier);
+ std::tuple<OmpReductionIdentifier, OmpTypeNameList,
+ std::optional<OmpReductionCombiner>>
+ t;
+};
+
+struct OmpArgument {
+ CharBlock source;
+ UNION_CLASS_BOILERPLATE(OmpArgument);
+ std::variant<OmpLocator, // {variable, extended, locator}-list-item
+ OmpMapperSpecifier, OmpReductionSpecifier>
+ u;
+};
+} // namespace arguments
inline namespace traits {
// trait-property-name ->
@@ -3617,6 +3670,16 @@ struct OmpContextSelectorSpecification { // Modifier
};
} // namespace traits
+#define MODIFIER_BOILERPLATE(...) \
+ struct Modifier { \
+ using Variant = std::variant<__VA_ARGS__>; \
+ UNION_CLASS_BOILERPLATE(Modifier); \
+ CharBlock source; \
+ Variant u; \
+ }
+
+#define MODIFIERS() std::optional<std::list<Modifier>>
+
inline namespace modifier {
// For uniformity, in all keyword modifiers the name of the type defined
// by ENUM_CLASS is "Value", e.g.
@@ -3829,18 +3892,6 @@ struct OmpPrescriptiveness {
WRAPPER_CLASS_BOILERPLATE(OmpPrescriptiveness, Value);
};
-// Ref: [4.5:201-207], [5.0:293-299], [5.1:325-331], [5.2:124]
-//
-// reduction-identifier ->
-// base-language-identifier | // since 4.5
-// - | // since 4.5, until 5.2
-// + | * | .AND. | .OR. | .EQV. | .NEQV. | // since 4.5
-// MIN | MAX | IAND | IOR | IEOR // since 4.5
-struct OmpReductionIdentifier {
- UNION_CLASS_BOILERPLATE(OmpReductionIdentifier);
- std::variant<DefinedOperator, ProcedureDesignator> u;
-};
-
// Ref: [5.0:300-302], [5.1:332-334], [5.2:134-137]
//
// reduction-modifier ->
@@ -3983,7 +4034,9 @@ struct OmpBindClause {
struct OmpDefaultClause {
ENUM_CLASS(DataSharingAttribute, Private, Firstprivate, Shared, None)
UNION_CLASS_BOILERPLATE(OmpDefaultClause);
- std::variant<DataSharingAttribute, OmpDirectiveSpecification> u;
+ std::variant<DataSharingAttribute,
+ common::Indirection<OmpDirectiveSpecification>>
+ u;
};
// Ref: [4.5:103-107], [5.0:324-325], [5.1:357-358], [5.2:161-162]
@@ -4248,8 +4301,8 @@ struct OmpOrderClause {
// otherwise-clause ->
// OTHERWISE ([directive-specification])] // since 5.2
struct OmpOtherwiseClause {
- WRAPPER_CLASS_BOILERPLATE(
- OmpOtherwiseClause, std::optional<OmpDirectiveSpecification>);
+ WRAPPER_CLASS_BOILERPLATE(OmpOtherwiseClause,
+ std::optional<common::Indirection<OmpDirectiveSpecification>>);
};
// Ref: [4.5:46-50], [5.0:74-78], [5.1:92-96], [5.2:229-230]
@@ -4345,7 +4398,9 @@ struct OmpUpdateClause {
struct OmpWhenClause {
TUPLE_CLASS_BOILERPLATE(OmpWhenClause);
MODIFIER_BOILERPLATE(OmpContextSelector);
- std::tuple<MODIFIERS(), std::optional<OmpDirectiveSpecification>> t;
+ std::tuple<MODIFIERS(),
+ std::optional<common::Indirection<OmpDirectiveSpecification>>>
+ t;
};
// OpenMP Clauses
@@ -4372,6 +4427,14 @@ struct OmpClauseList {
// --- Directives and constructs
+struct OmpDirectiveSpecification {
+ CharBlock source;
+ TUPLE_CLASS_BOILERPLATE(OmpDirectiveSpecification);
+ std::tuple<llvm::omp::Directive, std::optional<std::list<OmpArgument>>,
+ std::optional<OmpClauseList>>
+ t;
+};
+
struct OmpMetadirectiveDirective {
TUPLE_CLASS_BOILERPLATE(OmpMetadirectiveDirective);
std::tuple<OmpClauseList> t;
@@ -4472,27 +4535,16 @@ struct OpenMPDeclareTargetConstruct {
std::tuple<Verbatim, OmpDeclareTargetSpecifier> t;
};
-struct OmpDeclareMapperSpecifier {
- TUPLE_CLASS_BOILERPLATE(OmpDeclareMapperSpecifier);
- std::tuple<std::optional<Name>, TypeSpec, Name> t;
-};
-
// OMP v5.2: 5.8.8
// declare-mapper -> DECLARE MAPPER ([mapper-name :] type :: var) map-clauses
struct OpenMPDeclareMapperConstruct {
TUPLE_CLASS_BOILERPLATE(OpenMPDeclareMapperConstruct);
CharBlock source;
- std::tuple<Verbatim, OmpDeclareMapperSpecifier, OmpClauseList> t;
+ std::tuple<Verbatim, OmpMapperSpecifier, OmpClauseList> t;
};
// 2.16 declare-reduction -> DECLARE REDUCTION (reduction-identifier : type-list
// : combiner) [initializer-clause]
-struct OmpReductionCombiner {
- UNION_CLASS_BOILERPLATE(OmpReductionCombiner);
- WRAPPER_CLASS(FunctionCombiner, Call);
- std::variant<AssignmentStmt, FunctionCombiner> u;
-};
-
WRAPPER_CLASS(OmpReductionInitializerClause, Expr);
struct OpenMPDeclareReductionConstruct {
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index f5387dcf4b3c3df..e73e0ac2c85ff9d 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -68,6 +68,8 @@ void OmpDirectiveNameParser::initTokens(NameWithId *table) const {
[](auto &a, auto &b) { return a.first.size() > b.first.size(); });
}
+// --- Modifier helpers -----------------------------------------------
+
template <typename Clause, typename Separator> struct ModifierList {
constexpr ModifierList(Separator sep) : sep_(sep) {}
constexpr ModifierList(const ModifierList &) = default;
@@ -118,10 +120,8 @@ struct SpecificModifierParser {
}
};
-// OpenMP Clauses
+// --- Iterator helpers -----------------------------------------------
-// [5.0] 2.1.6 iterator-specifier -> type-declaration-stmt = subscript-triple |
-// identifier = subscript-triple
// [5.0:47:17-18] In an iterator-specifier, if the iterator-type is not
// specified then the type of that iterator is default integer.
// [5.0:49:14] The iterator-type must be an integer type.
@@ -153,8 +153,30 @@ static TypeDeclarationStmt makeIterSpecDecl(std::list<ObjectName> &&names) {
makeEntityList(std::move(names)));
}
-TYPE_PARSER(sourced(construct<OmpDirectiveSpecification>(
- OmpDirectiveNameParser{}, maybe(indirect(Parser<OmpClauseList>{})))))
+// --- Parsers for arguments ------------------------------------------
+
+// At the moment these are only directive arguments. This is needed for
+// parsing directive-specification.
+
+TYPE_PARSER( //
+ construct<OmpLocator>(Parser<OmpObject>{}) ||
+ construct<OmpLocator>(Parser<FunctionReference>{}))
+
+TYPE_PARSER(sourced( //
+ construct<OmpArgument>(Parser<OmpMapperSpecifier>{}) ||
+ construct<OmpArgument>(Parser<OmpReductionSpecifier>{}) ||
+ construct<OmpArgument>(Parser<OmpLocator>{})))
+
+TYPE_PARSER(construct<OmpLocatorList>(nonemptyList(Parser<OmpLocator>{})))
+
+TYPE_PARSER( //
+ construct<OmpTypeSpecifier>(Parser<TypeSpec>{}) ||
+ construct<OmpTypeSpecifier>(Parser<DeclarationTypeSpec>{}))
+
+TYPE_PARSER(construct<OmpReductionSpecifier>( //
+ Parser<OmpReductionIdentifier>{},
+ ":"_tok >> nonemptyList(Parser<OmpTypeSpecifier>{}),
+ maybe(":"_tok >> Parser<OmpReductionCombiner>{})))
// --- Parsers for context traits -------------------------------------
@@ -213,15 +235,11 @@ 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, ",");
- }};
-
using P = OmpTraitProperty;
return maybe("(" >> //
construct<OmpTraitSelector::Properties>(
maybe(Parser<OmpTraitScore>{} / ":"),
- (attempt(listOf(sourced(construct<P>(pp))) / ")") || ...)));
+ (attempt(nonemptyList(sourced(construct<P>(pp))) / ")") || ...)));
}
// Parser for OmpTraitSelector
@@ -309,7 +327,7 @@ TYPE_PARSER(sourced(construct<OmpTraitSetSelector>( //
TYPE_PARSER(sourced(construct<OmpContextSelectorSpecification>(
nonemptySeparated(Parser<OmpTraitSetSelector>{}, ","))))
-// Parser<OmpContextSelector> == Parser<traits::OmpContextSelectorSpecification>
+// Note: OmpContextSelector is a type alias.
// --- Parsers for clause modifiers -----------------------------------
@@ -543,7 +561,7 @@ TYPE_PARSER(construct<OmpDefaultClause::DataSharingAttribute>(
TYPE_PARSER(construct<OmpDefaultClause>(
construct<OmpDefaultClause>(
Parser<OmpDefaultClause::DataSharingAttribute>{}) ||
- construct<OmpDefaultClause>(Parser<OmpDirectiveSpecification>{})))
+ construct<OmpDefaultClause>(indirect(Parser<OmpDirectiveSpecification>{}))))
// 2.5 PROC_BIND (MASTER | CLOSE | PRIMARY | SPREAD)
TYPE_PARSER(construct<OmpProcBindClause>(
@@ -713,11 +731,11 @@ TYPE_PARSER(construct<OmpMatchClause>(
Parser<traits::OmpContextSelectorSpecification>{}))
TYPE_PARSER(construct<OmpOtherwiseClause>(
- maybe(sourced(Parser<OmpDirectiveSpecification>{}))))
+ maybe(indirect(sourced(Parser<OmpDirectiveSpecification>{})))))
TYPE_PARSER(construct<OmpWhenClause>(
maybe(nonemptyList(Parser<OmpWhenClause::Modifier>{}) / ":"),
- maybe(sourced(Parser<OmpDirectiveSpecification>{}))))
+ maybe(indirect(sourced(Parser<OmpDirectiveSpecification>{})))))
// OMP 5.2 12.6.1 grainsize([ prescriptiveness :] scalar-integer-expression)
TYPE_PARSER(construct<OmpGrainsizeClause>(
@@ -929,6 +947,13 @@ TYPE_PARSER(construct<OmpObjectList>(nonemptyList(Parser<OmpObject>{})))
TYPE_PARSER(sourced(construct<OmpErrorDirective>(
verbatim("ERROR"_tok), Parser<OmpClauseList>{})))
+// --- Parsers for directives and constructs --------------------------
+
+TYPE_PARSER(sourced(construct<OmpDirectiveSpecification>( //
+ OmpDirectiveNameParser{},
+ maybe(parenthesized(nonemptyList(Parser<OmpArgument>{}))),
+ maybe(Parser<OmpClauseList>{}))))
+
TYPE_PARSER(sourced(construct<OmpNothingDirective>("NOTHING" >> ok)))
TYPE_PARSER(sourced(construct<OpenMPUtilityConstruct>(
@@ -1141,20 +1166,17 @@ TYPE_PARSER(
TYPE_PARSER(sourced(construct<OpenMPDeclareTargetConstruct>(
verbatim("DECLARE TARGET"_tok), Parser<OmpDeclareTargetSpecifier>{})))
-// declare-mapper-specifier
-TYPE_PARSER(construct<OmpDeclareMapperSpecifier>(
+// mapper-specifier
+TYPE_PARSER(construct<OmpMapperSpecifier>(
maybe(name / ":" / !":"_tok), typeSpec / "::", name))
// OpenMP 5.2: 5.8.8 Declare Mapper Construct
-TYPE_PARSER(sourced(construct<OpenMPDeclareMapperConstruct>(
- verbatim("DECLARE MAPPER"_tok),
- "(" >> Parser<OmpDeclareMapperSpecifier>{} / ")", Parser<OmpClauseList>{})))
+TYPE_PARSER(sourced(
+ construct<OpenMPDeclareMapperConstruct>(verbatim("DECLARE MAPPER"_tok),
+ parenthesized(Parser<OmpMapperSpecifier>{}), Parser<OmpClauseList>{})))
TYPE_PARSER(construct<OmpReductionCombiner>(Parser<AssignmentStmt>{}) ||
- construct<OmpReductionCombiner>(
- construct<OmpReductionCombiner::FunctionCombiner>(
- construct<Call>(Parser<ProcedureDesignator>{},
- parenthesized(optionalList(actualArgSpec))))))
+ construct<OmpReductionCombiner>(Parser<FunctionReference>{}))
// 2.17.7 atomic -> ATOMIC [clause [,]] atomic-clause [[,] clause] |
// ATOMIC [clause]
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 7d3b03e5bc27e72..bc1c472f276ea14 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2067,12 +2067,33 @@ class UnparseVisitor {
}
// OpenMP Clauses & Directives
+ void Unparse(const OmpTypeNameList &x) { //
+ Walk(x.v, ",");
+ }
+ void Unparse(const OmpMapperSpecifier &x) {
+ Walk(std::get<std::optional<Name>>(x.t), ":");
+ Walk(std::get<TypeSpec>(x.t));
+ Put("::");
+ Walk(std::get<Name>(x.t));
+ }
+ void Unparse(const OmpReductionSpecifier &x) {
+ Walk(std::get<OmpReductionIdentifier>(x.t));
+ Put(":");
+ Walk(std::get<OmpTypeNameList>(x.t));
+ Walk(":", std::get<std::optional<OmpReductionCombiner>>(x.t));
+ }
void Unparse(const llvm::omp::Directive &x) {
Word(llvm::omp::getOpenMPDirectiveName(x).str());
}
void Unparse(const OmpDirectiveSpecification &x) {
+ using ArgList = std::list<parser::OmpArgument>;
Walk(std::get<llvm::omp::Directive>(x.t));
- Walk(std::get<std::optional<common::Indirection<OmpClauseList>>>(x.t));
+ if (auto &args{std::get<std::optional<ArgList>>(x.t)}) {
+ Put("(");
+ Walk(*args);
+ Put(")");
+ }
+ Walk(std::get<std::optional<OmpClauseList>>(x.t));
}
void Unparse(const OmpTraitScore &x) {
Word("SCORE(");
@@ -2297,8 +2318,9 @@ class UnparseVisitor {
}
void Unparse(const OmpWhenClause &x) {
using Modifier = OmpWhenClause::Modifier;
+ using Directive = common::Indirection<OmpDirectiveSpecification>;
Walk(std::get<std::optional<std::list<Modifier>>>(x.t), ": ");
- Walk(std::get<std::optional<OmpDirectiveSpecification>>(x.t));
+ Walk(std::get<std::optional<Directive>>(x.t));
}
#define GEN_FLANG_CLAUSE_UNPARSE
#include "llvm/Frontend/OpenMP/OMP.inc"
@@ -2660,18 +2682,6 @@ class UnparseVisitor {
Walk(x.v);
Put(")");
}
- void Unparse(const OmpReductionCombiner::FunctionCombiner &x) {
- const auto &pd = std::get<ProcedureDesignator>(x.v.t);
- const auto &args = std::get<std::list<ActualArgSpec>>(x.v.t);
- Walk(pd);
- if (args.empty()) {
- if (std::holds_alternative<ProcComponentRef>(pd.u)) {
- Put("()");
- }
- } else {
- Walk("(", args, ", ", ")");
- }
- }
void Unparse(const OpenMPDeclareReductionConstruct &x) {
BeginOpenMP();
Word("!$OMP DECLARE REDUCTION ");
@@ -2687,7 +2697,7 @@ class UnparseVisitor {
void Unparse(const OpenMPDeclareMapperConstruct &z) {
BeginOpenMP();
Word("!$OMP DECLARE MAPPER (");
- const auto &spec{std::get<OmpDeclareMapperSpecifier>(z.t)};
+ const auto &spec{std::get<OmpMapperSpecifier>(z.t)};
if (auto mapname{std::get<std::optional<Name>>(spec.t)}) {
Walk(mapname);
Put(":");
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 94886d6b9dfdc9f..bde97e0b87e5651 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1606,7 +1606,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
PushContextAndClauseSets(
dir.source, llvm::omp::Directive::OMPD_declare_mapper);
- const auto &spec{std::get<parser::OmpDeclareMapperSpecifier>(x.t)};
+ const auto &spec{std::get<parser::OmpMapperSpecifier>(x.t)};
const auto &type = std::get<parser::TypeSpec>(spec.t);
if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {
context_.Say(dir.source, "Type is not a derived type"_err_en_US);
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f3c2a5bf094d04b..82bfaa1385fbba7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1471,7 +1471,12 @@ class OmpVisitor : public virtual DeclarationVisitor {
return true;
}
- bool Pre(const parser::OpenMPDeclareMapperConstruct &);
+ bool Pre(const parser::OpenMPDeclareMapperConstruct &x) {
+ AddOmpSourceRange(x.source);
+ ProcessMapperSpecifier(std::get<parser::OmpMapperSpecifier>(x.t),
+ std::get<parser::OmpClauseList>(x.t));
+ return false;
+ }
bool Pre(const parser::OmpMapClause &);
@@ -1573,6 +1578,21 @@ class OmpVisitor : public virtual DeclarationVisitor {
PopScope();
}
}
+ bool Pre(const parser::OmpDirectiveSpecification &x);
+
+ bool Pre(const parser::OmpTypeSpecifier &x) {
+ BeginDeclTypeSpec();
+ return true;
+ }
+ void Post(const parser::OmpTypeSpecifier &x) { //
+ EndDeclTypeSpec();
+ }
+
+private:
+ void ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
+ const parser::OmpClauseList &clauses);
+ void ProcessReductionSpecifier(const parser::OmpReductionSpecifier &spec,
+ const parser::OmpClauseList &clauses);
};
bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
@@ -1612,37 +1632,6 @@ void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
}
}
-// This "manually" walks the tree of the construct, because we need
-// to resolve the type before the map clauses are processed - when
-// just following the natural flow, the map clauses gets processed before
-// the type has been fully processed.
-bool OmpVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) {
- AddOmpSourceRange(x.source);
- BeginDeclTypeSpec();
- const auto &spec{std::get<parser::OmpDeclareMapperSpecifier>(x.t)};
- Symbol *mapperSym{nullptr};
- if (const auto &mapperName{std::get<std::optional<parser::Name>>(spec.t)}) {
- mapperSym =
- &MakeSymbol(*mapperName, MiscDetails{MiscDetails::Kind::ConstructName});
- mapperName->symbol = mapperSym;
- } else {
- const parser::CharBlock defaultName{"default", 7};
- mapperSym = &MakeSymbol(
- defaultName, Attrs{}, MiscDetails{MiscDetails::Kind::ConstructName});
- }
-
- PushScope(Scope::Kind::OtherConstruct, nullptr);
- Walk(std::get<parser::TypeSpec>(spec.t));
- const auto &varName{std::get<parser::ObjectName>(spec.t)};
- DeclareObjectEntity(varName);
-
- Walk(std::get<parser::OmpClauseList>(x.t));
-
- EndDeclTypeSpec();
- PopScope();
- return false;
-}
-
bool OmpVisitor::Pre(const parser::OmpMapClause &x) {
auto &mods{OmpGetModifiers(x)};
if (auto *mapper{OmpGetUniqueModifier<parser::OmpMapper>(mods)}) {
@@ -1670,6 +1659,83 @@ bool OmpVisitor::Pre(const parser::OmpMapClause &x) {
return true;
}
+void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
+ const parser::OmpClauseList &clauses) {
+ // This "manually" walks the tree of the construct, because we need
+ // to resolve the type before the map clauses are processed - when
+ // just following the natural flow, the map clauses gets processed before
+ // the type has been fully processed.
+ BeginDeclTypeSpec();
+ if (auto &mapperName{std::get<std::optional<parser::Name>>(spec.t)}) {
+ mapperName->symbol =
+ &MakeSymbol(*mapperName, MiscDetails{MiscDetails::Kind::ConstructName});
+ } else {
+ const parser::CharBlock defaultName{"default", 7};
+ MakeSymbol(
+ defaultName, Attrs{}, MiscDetails{MiscDetails::Kind::ConstructName});
+ }
+
+ PushScope(Scope::Kind::OtherConstruct, nullptr);
+ Walk(std::get<parser::TypeSpec>(spec.t));
+ auto &varName{std::get<parser::Name>(spec.t)};
+ DeclareObjectEntity(varName);
+
+ Walk(clauses);
+ EndDeclTypeSpec();
+ PopScope();
+}
+
+void OmpVisitor::ProcessReductionSpecifier(
+ const parser::OmpReductionSpecifier &spec,
+ const parser::OmpClauseList &clauses) {
+ // Creating a new scope in case the combiner expression (or clauses) use
+ // reerved identifiers, like "omp_in". This is a temporary solution until
+ // we deal with these in a more thorough way.
+ PushScope(Scope::Kind::OtherConstruct, nullptr);
+ Walk(std::get<parser::OmpReductionIdentifier>(spec.t));
+ Walk(std::get<parser::OmpTypeNameList>(spec.t));
+ Walk(std::get<std::optional<parser::OmpReductionCombiner>>(spec.t));
+ Walk(clauses);
+ PopScope();
+}
+
+bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
+ // OmpDirectiveSpecification is only used in METADIRECTIVE at the moment.
+ // Since it contains directives and clauses, some semantic checks may
+ // not be applicable.
+ // Disable the semantic analysis for it for now to allow the compiler to
+ // parse METADIRECTIVE without flagging errors.
+ AddOmpSourceRange(x.source);
+ auto dirId{std::get<llvm::omp::Directive>(x.t)};
+ auto &maybeArgs{std::get<std::optional<std::list<parser::OmpArgument>>>(x.t)};
+ auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.t)};
+
+ switch (dirId) {
+ case llvm::omp::Directive::OMPD_declare_mapper:
+ if (maybeArgs && maybeClauses) {
+ const parser::OmpArgument &first{maybeArgs->front()};
+ if (auto *spec{std::get_if<parser::OmpMapperSpecifier>(&first.u)}) {
+ ProcessMapperSpecifier(*spec, *maybeClauses);
+ }
+ }
+ break;
+ case llvm::omp::Directive::OMPD_declare_reduction:
+ if (maybeArgs && maybeClauses) {
+ const parser::OmpArgument &first{maybeArgs->front()};
+ if (auto *spec{std::get_if<parser::OmpReductionSpecifier>(&first.u)}) {
+ ProcessReductionSpecifier(*spec, *maybeClauses);
+ }
+ }
+ break;
+ default:
+ // Default processing.
+ Walk(maybeArgs);
+ Walk(maybeClauses);
+ break;
+ }
+ return false;
+}
+
// Walk the parse tree and resolve names to symbols.
class ResolveNamesVisitor : public virtual ScopeHandler,
public ModuleVisitor,
diff --git a/flang/test/Parser/OpenMP/declare-mapper-unparse.f90 b/flang/test/Parser/OpenMP/declare-mapper-unparse.f90
index 5ba147d20955e33..407bfd29153fad5 100644
--- a/flang/test/Parser/OpenMP/declare-mapper-unparse.f90
+++ b/flang/test/Parser/OpenMP/declare-mapper-unparse.f90
@@ -13,7 +13,7 @@ program main
!$omp declare mapper(mymapper : ty :: mapped) map(mapped, mapped%x)
!PARSE-TREE: OpenMPDeclareMapperConstruct
-!PARSE-TREE: OmpDeclareMapperSpecifier
+!PARSE-TREE: OmpMapperSpecifier
!PARSE-TREE: Name = 'mymapper'
!PARSE-TREE: TypeSpec -> DerivedTypeSpec
!PARSE-TREE: Name = 'ty'
@@ -28,7 +28,7 @@ program main
!$omp declare mapper(ty :: mapped) map(mapped, mapped%x)
!PARSE-TREE: OpenMPDeclareMapperConstruct
-!PARSE-TREE: OmpDeclareMapperSpecifier
+!PARSE-TREE: OmpMapperSpecifier
!PARSE-TREE: TypeSpec -> DerivedTypeSpec
!PARSE-TREE: Name = 'ty'
!PARSE-TREE: Name = 'mapped'
diff --git a/flang/test/Parser/OpenMP/metadirective-dirspec.f90 b/flang/test/Parser/OpenMP/metadirective-dirspec.f90
new file mode 100644
index 000000000000000..73520c41fe77da7
--- /dev/null
+++ b/flang/test/Parser/OpenMP/metadirective-dirspec.f90
@@ -0,0 +1,242 @@
+!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
+
+!Directive specification where directives have arguments
+
+subroutine f00(x)
+ integer :: x(10)
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & allocate(x))
+end
+
+!UNPARSE: SUBROUTINE f00 (x)
+!UNPARSE: INTEGER x(10_4)
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: ALLOCATE(x))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> 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 = allocate
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f01(x)
+ integer :: x
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & critical(x))
+end
+
+!UNPARSE: SUBROUTINE f01 (x)
+!UNPARSE: INTEGER x
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: CRITICAL(x))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> 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 = critical
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f02
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & declare mapper(mymapper : integer :: v) map(tofrom: v))
+end
+
+!UNPARSE: SUBROUTINE f02
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: DECLARE MAPPER(mymapper:INTEGER:&
+!UNPARSE: !$OMP&:v) MAP(TOFROM: v))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: OpenMPDeclarativeConstruct -> 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 = declare mapper
+!PARSE-TREE: | | | OmpArgument -> OmpMapperSpecifier
+!PARSE-TREE: | | | | Name = 'mymapper'
+!PARSE-TREE: | | | | TypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec ->
+!PARSE-TREE: | | | | Name = 'v'
+!PARSE-TREE: | | | OmpClauseList -> OmpClause -> Map -> OmpMapClause
+!PARSE-TREE: | | | | Modifier -> OmpMapType -> Value = Tofrom
+!PARSE-TREE: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'v'
+!PARSE-TREE: | | | | bool = 'true'
+!PARSE-TREE: ImplicitPart ->
+
+subroutine f03
+ type :: tt1
+ integer :: x
+ endtype
+ type :: tt2
+ real :: a
+ endtype
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & declare reduction(+ : tt1, tt2 : omp_out = omp_in + omp_out))
+end
+
+!UNPARSE: SUBROUTINE f03
+!UNPARSE: TYPE :: tt1
+!UNPARSE: INTEGER :: x
+!UNPARSE: END TYPE
+!UNPARSE: TYPE :: tt2
+!UNPARSE: REAL :: a
+!UNPARSE: END TYPE
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: DECLARE REDUCTION(+:tt1,tt2: omp_out=omp_in+omp_out
+!UNPARSE: ))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> 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 = declare reduction
+!PARSE-TREE: | | | OmpArgument -> OmpReductionSpecifier
+!PARSE-TREE: | | | | OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add
+!PARSE-TREE: | | | | OmpTypeNameList -> OmpTypeSpecifier -> TypeSpec -> DerivedTypeSpec
+!PARSE-TREE: | | | | | Name = 'tt1'
+!PARSE-TREE: | | | | OmpTypeSpecifier -> TypeSpec -> DerivedTypeSpec
+!PARSE-TREE: | | | | | Name = 'tt2'
+!PARSE-TREE: | | | | OmpReductionCombiner -> AssignmentStmt = 'omp_out=omp_in+omp_out'
+!PARSE-TREE: | | | | | Variable = 'omp_out'
+!PARSE-TREE: | | | | | | Designator -> DataRef -> Name = 'omp_out'
+!PARSE-TREE: | | | | | Expr = 'omp_in+omp_out'
+!PARSE-TREE: | | | | | | Add
+!PARSE-TREE: | | | | | | | Expr = 'omp_in'
+!PARSE-TREE: | | | | | | | | Designator -> DataRef -> Name = 'omp_in'
+!PARSE-TREE: | | | | | | | Expr = 'omp_out'
+!PARSE-TREE: | | | | | | | | Designator -> DataRef -> Name = 'omp_out'
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f04
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & declare simd(f04))
+end
+
+!UNPARSE: SUBROUTINE f04
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: DECLARE SIMD(f04))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: OpenMPDeclarativeConstruct -> 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 = declare simd
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'f04'
+!PARSE-TREE: | | | OmpClauseList ->
+!PARSE-TREE: ImplicitPart ->
+
+subroutine f05
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & declare target(f05))
+end
+
+!UNPARSE: SUBROUTINE f05
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: DECLARE TARGET(f05))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: OpenMPDeclarativeConstruct -> 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 = declare target
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'f05'
+!PARSE-TREE: | | | OmpClauseList ->
+!PARSE-TREE: ImplicitPart ->
+
+subroutine f06(x, y)
+ integer :: x, y
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & flush(x, y))
+end
+
+!UNPARSE: SUBROUTINE f06 (x, y)
+!UNPARSE: INTEGER x, y
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: FLUSH(x, y))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> 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 = flush
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'x'
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'y'
+!PARSE-TREE: | | | OmpClauseList ->
+
+subroutine f07
+ integer :: t
+ !$omp metadirective when(user={condition(.true.)}: &
+ !$omp & threadprivate(t))
+end
+
+!UNPARSE: SUBROUTINE f07
+!UNPARSE: INTEGER t
+!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: THREADPRIVATE(t))
+!UNPARSE: END SUBROUTINE
+
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> 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 = threadprivate
+!PARSE-TREE: | | | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 't'
+!PARSE-TREE: | | | OmpClauseList ->
>From fc053b318d098491b0e6d6f79e93ef20c19117c3 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Mon, 3 Feb 2025 12:16:26 -0600
Subject: [PATCH 13/13] Remove duplicate class definition
---
flang/include/flang/Parser/parse-tree.h | 8 --------
1 file changed, 8 deletions(-)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 7ac99bd45dc0a0f..d7b1ae9893c031a 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3459,14 +3459,6 @@ WRAPPER_CLASS(PauseStmt, std::optional<StopCode>);
struct OmpClause;
struct OmpDirectiveSpecification;
-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.
More information about the flang-commits
mailing list