[flang-commits] [flang] [flang][OpenMP] Use OmpDirectiveSpecification in THREADPRIVATE (PR #159632)
Krzysztof Parzyszek via flang-commits
flang-commits at lists.llvm.org
Mon Sep 22 08:23:27 PDT 2025
https://github.com/kparzysz updated https://github.com/llvm/llvm-project/pull/159632
>From b34629f252da8079829d92eaef33837b46963636 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 18 Sep 2025 13:57:38 -0500
Subject: [PATCH 1/6] [flang][OpenMP] Reject blank common blocks more
gracefully
Parse them as "invalid" OmpObjects, then emit a diagnostic in semantic
checks.
---
flang/include/flang/Parser/dump-parse-tree.h | 2 +
flang/include/flang/Parser/parse-tree.h | 9 +++-
flang/lib/Parser/openmp-parsers.cpp | 7 ++-
flang/lib/Parser/unparse.cpp | 20 +++++++--
flang/lib/Semantics/check-omp-loop.cpp | 5 ++-
flang/lib/Semantics/check-omp-structure.cpp | 44 ++++++++++++------
flang/lib/Semantics/openmp-utils.cpp | 4 +-
flang/lib/Semantics/resolve-directives.cpp | 27 +++++++----
flang/lib/Semantics/resolve-names.cpp | 45 +++++++++++--------
.../threadprivate-blank-common-block.f90 | 9 ----
.../Semantics/OpenMP/blank-common-block.f90 | 18 ++++++++
11 files changed, 132 insertions(+), 58 deletions(-)
delete mode 100644 flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90
create mode 100644 flang/test/Semantics/OpenMP/blank-common-block.f90
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 1c9fd7673e06d..0b6e3fd6a3b6b 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -634,6 +634,8 @@ class ParseTreeDumper {
NODE(parser, OmpNumTasksClause)
NODE(OmpNumTasksClause, Modifier)
NODE(parser, OmpObject)
+ NODE(OmpObject, Invalid)
+ NODE_ENUM(OmpObject::Invalid, Kind)
NODE(parser, OmpObjectList)
NODE(parser, OmpOrderClause)
NODE(OmpOrderClause, Modifier)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 7307283eb91ec..09a45476420df 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3505,8 +3505,15 @@ struct OmpDirectiveName {
// in slashes). An extended list item is a list item or a procedure Name.
// variable-name | / common-block / | array-sections
struct OmpObject {
+ // Blank common blocks are not valid objects. Parse them to emit meaningful
+ // diagnostics.
+ struct Invalid {
+ ENUM_CLASS(Kind, BlankCommonBlock);
+ WRAPPER_CLASS_BOILERPLATE(Invalid, Kind);
+ CharBlock source;
+ };
UNION_CLASS_BOILERPLATE(OmpObject);
- std::variant<Designator, /*common block*/ Name> u;
+ std::variant<Designator, /*common block*/ Name, Invalid> u;
};
WRAPPER_CLASS(OmpObjectList, std::list<OmpObject>);
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index c6d4de108fb59..66526ba00b5ed 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -1024,8 +1024,11 @@ TYPE_PARSER(construct<OmpNumTasksClause>(
maybe(nonemptyList(Parser<OmpNumTasksClause::Modifier>{}) / ":"),
scalarIntExpr))
-TYPE_PARSER(
- construct<OmpObject>(designator) || "/" >> construct<OmpObject>(name) / "/")
+TYPE_PARSER( //
+ construct<OmpObject>(designator) ||
+ "/" >> construct<OmpObject>(name) / "/" ||
+ construct<OmpObject>(sourced(construct<OmpObject::Invalid>(
+ "//"_tok >> pure(OmpObject::Invalid::Kind::BlankCommonBlock)))))
// OMP 5.0 2.19.4.5 LASTPRIVATE ([lastprivate-modifier :] list)
TYPE_PARSER(construct<OmpLastprivateClause>(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 73bbbc04f46b1..189a34ee1dc56 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2168,10 +2168,22 @@ class UnparseVisitor {
void Unparse(const OmpContextSelectorSpecification &x) { Walk(x.v, ", "); }
void Unparse(const OmpObject &x) {
- common::visit(common::visitors{
- [&](const Designator &y) { Walk(y); },
- [&](const Name &y) { Put("/"), Walk(y), Put("/"); },
- },
+ common::visit( //
+ common::visitors{
+ [&](const Designator &y) { Walk(y); },
+ [&](const Name &y) {
+ Put("/");
+ Walk(y);
+ Put("/");
+ },
+ [&](const OmpObject::Invalid &y) {
+ switch (y.v) {
+ case OmpObject::Invalid::Kind::BlankCommonBlock:
+ Put("//");
+ break;
+ }
+ },
+ },
x.u);
}
void Unparse(const OmpDirectiveNameModifier &x) {
diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp
index 562bd1b4e79a4..c9d0495850b6e 100644
--- a/flang/lib/Semantics/check-omp-loop.cpp
+++ b/flang/lib/Semantics/check-omp-loop.cpp
@@ -491,7 +491,10 @@ void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
checkReductionSymbolInScan(name);
}
},
- [&](const auto &name) { checkReductionSymbolInScan(&name); },
+ [&](const parser::Name &name) {
+ checkReductionSymbolInScan(&name);
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObj.u);
}
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 4c7cd1734e0e7..1ee5385fb38a1 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -269,7 +269,8 @@ bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
}
void OmpStructureChecker::AnalyzeObject(const parser::OmpObject &object) {
- if (std::holds_alternative<parser::Name>(object.u)) {
+ if (std::holds_alternative<parser::Name>(object.u) ||
+ std::holds_alternative<parser::OmpObject::Invalid>(object.u)) {
// Do not analyze common block names. The analyzer will flag an error
// on those.
return;
@@ -294,7 +295,12 @@ void OmpStructureChecker::AnalyzeObject(const parser::OmpObject &object) {
}
evaluate::ExpressionAnalyzer ea{context_};
auto restore{ea.AllowWholeAssumedSizeArray(true)};
- common::visit([&](auto &&s) { ea.Analyze(s); }, object.u);
+ common::visit( //
+ common::visitors{
+ [&](auto &&s) { ea.Analyze(s); },
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
+ object.u);
}
void OmpStructureChecker::AnalyzeObjects(const parser::OmpObjectList &objects) {
@@ -538,6 +544,7 @@ void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
[&](const parser::Name &name) {
CheckPredefinedAllocatorRestriction(source, name);
},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -1302,7 +1309,11 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
const parser::OmpObjectList &objList) {
for (const auto &ompObject : objList.v) {
- common::visit([&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },
+ common::visit( //
+ common::visitors{
+ [&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
ompObject.u);
}
}
@@ -1434,8 +1445,14 @@ void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
// refer to the same depend object as the depobj argument of the construct.
if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {
auto getObjSymbol{[&](const parser::OmpObject &obj) {
- return common::visit(
- [&](auto &&s) { return GetLastName(s).symbol; }, obj.u);
+ return common::visit( //
+ common::visitors{
+ [&](auto &&s) { return GetLastName(s).symbol; },
+ [&](const parser::OmpObject::Invalid &invalid) {
+ return static_cast<Symbol *>(nullptr);
+ },
+ },
+ obj.u);
}};
auto getArgSymbol{[&](const parser::OmpArgument &arg) {
if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {
@@ -1450,9 +1467,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {
const Symbol *constrSym{getArgSymbol(arguments.v.front())};
const Symbol *clauseSym{getObjSymbol(destroy->v)};
- assert(constrSym && "Unresolved depobj construct symbol");
- assert(clauseSym && "Unresolved destroy symbol on depobj construct");
- if (constrSym != clauseSym) {
+ if (constrSym && clauseSym && constrSym != clauseSym) {
context_.Say(x.source,
"The DESTROY clause must refer to the same object as the "
"DEPOBJ construct"_err_en_US);
@@ -1690,6 +1705,7 @@ void OmpStructureChecker::CheckSymbolNames(
ContextDirectiveAsFortran());
}
},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -2710,6 +2726,7 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
}
}
},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -3417,6 +3434,7 @@ void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
}
},
[&](const parser::Name &name) {},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -4102,11 +4120,11 @@ void OmpStructureChecker::CheckStructureComponent(
}};
for (const auto &object : objects.v) {
- common::visit(
- common::visitors{
- CheckComponent,
- [&](const parser::Name &name) {},
- },
+ common::visit(common::visitors{
+ CheckComponent,
+ [&](const parser::Name &name) {},
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
object.u);
}
}
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 2980f827d3ef3..e75149f21d117 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -225,7 +225,7 @@ struct ContiguousHelper {
std::optional<bool> IsContiguous(
SemanticsContext &semaCtx, const parser::OmpObject &object) {
return common::visit( //
- common::visitors{
+ common::visitors{//
[&](const parser::Name &x) {
// Any member of a common block must be contiguous.
return std::optional<bool>{true};
@@ -237,7 +237,7 @@ std::optional<bool> IsContiguous(
}
return std::optional<bool>{};
},
- },
+ [&](const parser::OmpObject::Invalid &) { return std::nullopt; }},
object.u);
}
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index abb8f6430b29b..c2d1987f3ac91 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3123,14 +3123,25 @@ void OmpAttributeVisitor::ResolveOmpCommonBlock(
void OmpAttributeVisitor::ResolveOmpObject(
const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
- common::visit(common::visitors{
- [&](const parser::Designator &designator) {
- ResolveOmpDesignator(designator, ompFlag);
- },
- [&](const parser::Name &name) { // common block
- ResolveOmpCommonBlock(name, ompFlag);
- },
- },
+ common::visit( //
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ ResolveOmpDesignator(designator, ompFlag);
+ },
+ [&](const parser::Name &name) { // common block
+ ResolveOmpCommonBlock(name, ompFlag);
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {
+ switch (invalid.v) {
+ case parser::OmpObject::Invalid::Kind::BlankCommonBlock:
+ context_.Say(invalid.source,
+ "Blank common blocks are not allowed as directive or clause arguments"_err_en_US);
+ break;
+ default:
+ llvm_unreachable("Unexpected invalid object");
+ }
+ },
+ },
ompObject.u);
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index cdd8d6ff2f60e..830891a222161 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1625,25 +1625,34 @@ class OmpVisitor : public virtual DeclarationVisitor {
void Post(const parser::OpenMPThreadprivate &) { SkipImplicitTyping(false); }
bool Pre(const parser::OpenMPDeclareTargetConstruct &x) {
const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
- auto populateDeclareTargetNames{
- [this](const parser::OmpObjectList &objectList) {
- for (const auto &ompObject : objectList.v) {
- common::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *name{
- semantics::getDesignatorNameIfDataRef(
- designator)}) {
- specPartState_.declareTargetNames.insert(name->source);
- }
- },
- [&](const parser::Name &name) {
- specPartState_.declareTargetNames.insert(name.source);
- },
+ auto populateDeclareTargetNames{[this](const parser::OmpObjectList
+ &objectList) {
+ for (const auto &ompObject : objectList.v) {
+ common::visit(
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ if (const auto *name{
+ semantics::getDesignatorNameIfDataRef(designator)}) {
+ specPartState_.declareTargetNames.insert(name->source);
+ }
},
- ompObject.u);
- }
- }};
+ [&](const parser::Name &name) {
+ specPartState_.declareTargetNames.insert(name.source);
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {
+ switch (invalid.v) {
+ case parser::OmpObject::Invalid::Kind::BlankCommonBlock:
+ context().Say(invalid.source,
+ "Blank common blocks are not allowed as directive or clause arguments"_err_en_US);
+ break;
+ default:
+ llvm_unreachable("Unexpected invalid object");
+ }
+ },
+ },
+ ompObject.u);
+ }
+ }};
if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
populateDeclareTargetNames(*objectList);
diff --git a/flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90 b/flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90
deleted file mode 100644
index 6317258e6ec8d..0000000000000
--- a/flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90
+++ /dev/null
@@ -1,9 +0,0 @@
-! RUN: not %flang_fc1 -fsyntax-only %s -fopenmp 2>&1 | FileCheck %s
-! From Standard: A blank common block cannot appear in a threadprivate directive.
-
-program main
- integer :: a
- common//a
- !CHECK: error: expected one of '$@ABCDEFGHIJKLMNOPQRSTUVWXYZ_'
- !$omp threadprivate(//)
- end
diff --git a/flang/test/Semantics/OpenMP/blank-common-block.f90 b/flang/test/Semantics/OpenMP/blank-common-block.f90
new file mode 100644
index 0000000000000..4a217fced0ff7
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/blank-common-block.f90
@@ -0,0 +1,18 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+module m
+ integer :: a
+ common // a
+ !ERROR: Blank common blocks are not allowed as directive or clause arguments
+ !$omp declare_target(//)
+ !ERROR: Blank common blocks are not allowed as directive or clause arguments
+ !$omp threadprivate(//)
+end
+
+subroutine f00
+ integer :: a
+ common // a
+ !ERROR: Blank common blocks are not allowed as directive or clause arguments
+ !$omp parallel shared(//)
+ !$omp end parallel
+end
>From 105ca68c40f206a2cbeae669c4da9a4e9666abb4 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 18 Sep 2025 14:17:28 -0500
Subject: [PATCH 2/6] Handle switch-covers-all-cases errors
---
flang/lib/Semantics/resolve-directives.cpp | 3 +--
flang/lib/Semantics/resolve-names.cpp | 3 +--
2 files changed, 2 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index c2d1987f3ac91..28c74b8c1908b 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3133,12 +3133,11 @@ void OmpAttributeVisitor::ResolveOmpObject(
},
[&](const parser::OmpObject::Invalid &invalid) {
switch (invalid.v) {
+ SWITCH_COVERS_ALL_CASES
case parser::OmpObject::Invalid::Kind::BlankCommonBlock:
context_.Say(invalid.source,
"Blank common blocks are not allowed as directive or clause arguments"_err_en_US);
break;
- default:
- llvm_unreachable("Unexpected invalid object");
}
},
},
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 830891a222161..e97f0bf02a515 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1641,12 +1641,11 @@ class OmpVisitor : public virtual DeclarationVisitor {
},
[&](const parser::OmpObject::Invalid &invalid) {
switch (invalid.v) {
+ SWITCH_COVERS_ALL_CASES
case parser::OmpObject::Invalid::Kind::BlankCommonBlock:
context().Say(invalid.source,
"Blank common blocks are not allowed as directive or clause arguments"_err_en_US);
break;
- default:
- llvm_unreachable("Unexpected invalid object");
}
},
},
>From 7bb9fb5b3b9a2dfcd1d00f01c86fe26c5d14c30f Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 18 Sep 2025 08:49:38 -0500
Subject: [PATCH 3/6] [flang][OpenMP] Use OmpDirectiveSpecification in
THREADPRIVATE
Since ODS doesn't store a list of OmpObjects (i.e. not as OmpObjectList),
some semantics-checking functions needed to be updated to operate on a
single object at a time.
---
flang/include/flang/Parser/openmp-utils.h | 4 +-
flang/include/flang/Parser/parse-tree.h | 3 +-
flang/include/flang/Semantics/openmp-utils.h | 3 +-
flang/lib/Parser/openmp-parsers.cpp | 7 +-
flang/lib/Parser/unparse.cpp | 7 +-
flang/lib/Semantics/check-omp-structure.cpp | 89 +++++++++++---------
flang/lib/Semantics/check-omp-structure.h | 3 +
flang/lib/Semantics/openmp-utils.cpp | 22 +++--
flang/lib/Semantics/resolve-directives.cpp | 11 ++-
9 files changed, 86 insertions(+), 63 deletions(-)
diff --git a/flang/include/flang/Parser/openmp-utils.h b/flang/include/flang/Parser/openmp-utils.h
index 032fb8996fe48..1372945427955 100644
--- a/flang/include/flang/Parser/openmp-utils.h
+++ b/flang/include/flang/Parser/openmp-utils.h
@@ -49,7 +49,6 @@ MAKE_CONSTR_ID(OpenMPDeclareSimdConstruct, D::OMPD_declare_simd);
MAKE_CONSTR_ID(OpenMPDeclareTargetConstruct, D::OMPD_declare_target);
MAKE_CONSTR_ID(OpenMPExecutableAllocate, D::OMPD_allocate);
MAKE_CONSTR_ID(OpenMPRequiresConstruct, D::OMPD_requires);
-MAKE_CONSTR_ID(OpenMPThreadprivate, D::OMPD_threadprivate);
#undef MAKE_CONSTR_ID
@@ -111,8 +110,7 @@ struct DirectiveNameScope {
std::is_same_v<T, OpenMPDeclareSimdConstruct> ||
std::is_same_v<T, OpenMPDeclareTargetConstruct> ||
std::is_same_v<T, OpenMPExecutableAllocate> ||
- std::is_same_v<T, OpenMPRequiresConstruct> ||
- std::is_same_v<T, OpenMPThreadprivate>) {
+ std::is_same_v<T, OpenMPRequiresConstruct>) {
return MakeName(std::get<Verbatim>(x.t).source, ConstructId<T>::id);
} else {
return GetFromTuple(
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 09a45476420df..8cb6d2e744876 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -5001,9 +5001,8 @@ struct OpenMPRequiresConstruct {
// 2.15.2 threadprivate -> THREADPRIVATE (variable-name-list)
struct OpenMPThreadprivate {
- TUPLE_CLASS_BOILERPLATE(OpenMPThreadprivate);
+ WRAPPER_CLASS_BOILERPLATE(OpenMPThreadprivate, OmpDirectiveSpecification);
CharBlock source;
- std::tuple<Verbatim, OmpObjectList> t;
};
// 2.11.3 allocate -> ALLOCATE (variable-name-list) [clause]
diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 68318d6093a1e..65441728c5549 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -58,9 +58,10 @@ const parser::DataRef *GetDataRefFromObj(const parser::OmpObject &object);
const parser::ArrayElement *GetArrayElementFromObj(
const parser::OmpObject &object);
const Symbol *GetObjectSymbol(const parser::OmpObject &object);
-const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument);
std::optional<parser::CharBlock> GetObjectSource(
const parser::OmpObject &object);
+const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument);
+const parser::OmpObject *GetArgumentObject(const parser::OmpArgument &argument);
bool IsCommonBlock(const Symbol &sym);
bool IsExtendedListItem(const Symbol &sym);
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 66526ba00b5ed..60ce71cf983f6 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -1791,8 +1791,11 @@ TYPE_PARSER(sourced(construct<OpenMPRequiresConstruct>(
verbatim("REQUIRES"_tok), Parser<OmpClauseList>{})))
// 2.15.2 Threadprivate directive
-TYPE_PARSER(sourced(construct<OpenMPThreadprivate>(
- verbatim("THREADPRIVATE"_tok), parenthesized(Parser<OmpObjectList>{}))))
+TYPE_PARSER(sourced( //
+ construct<OpenMPThreadprivate>(
+ predicated(OmpDirectiveNameParser{},
+ IsDirective(llvm::omp::Directive::OMPD_threadprivate)) >=
+ Parser<OmpDirectiveSpecification>{})))
// 2.11.3 Declarative Allocate directive
TYPE_PARSER(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 189a34ee1dc56..db46525ac57b1 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2611,12 +2611,11 @@ class UnparseVisitor {
}
void Unparse(const OpenMPThreadprivate &x) {
BeginOpenMP();
- Word("!$OMP THREADPRIVATE (");
- Walk(std::get<parser::OmpObjectList>(x.t));
- Put(")\n");
+ Word("!$OMP ");
+ Walk(x.v);
+ Put("\n");
EndOpenMP();
}
-
bool Pre(const OmpMessageClause &x) {
Walk(x.v);
return false;
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 1ee5385fb38a1..507957dfecb3d 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -669,11 +669,6 @@ template <typename Checker> struct DirectiveSpellingVisitor {
checker_(x.v.DirName().source, Directive::OMPD_groupprivate);
return false;
}
- bool Pre(const parser::OpenMPThreadprivate &x) {
- checker_(
- std::get<parser::Verbatim>(x.t).source, Directive::OMPD_threadprivate);
- return false;
- }
bool Pre(const parser::OpenMPRequiresConstruct &x) {
checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_requires);
return false;
@@ -1306,15 +1301,20 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
}
}
+void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
+ const parser::OmpObject &object) {
+ common::visit( //
+ common::visitors{
+ [&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
+ object.u);
+}
+
void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
const parser::OmpObjectList &objList) {
for (const auto &ompObject : objList.v) {
- common::visit( //
- common::visitors{
- [&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },
- [&](const parser::OmpObject::Invalid &invalid) {},
- },
- ompObject.u);
+ CheckThreadprivateOrDeclareTargetVar(ompObject);
}
}
@@ -1374,18 +1374,20 @@ void OmpStructureChecker::Leave(const parser::OpenMPGroupprivate &x) {
dirContext_.pop_back();
}
-void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
- const auto &dir{std::get<parser::Verbatim>(c.t)};
- PushContextAndClauseSets(
- dir.source, llvm::omp::Directive::OMPD_threadprivate);
+void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &x) {
+ const parser::OmpDirectiveName &dirName{x.v.DirName()};
+ PushContextAndClauseSets(dirName.source, dirName.v);
}
-void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
- const auto &dir{std::get<parser::Verbatim>(c.t)};
- const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
- CheckSymbolNames(dir.source, objectList);
- CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
- CheckThreadprivateOrDeclareTargetVar(objectList);
+void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &x) {
+ const parser::OmpDirectiveSpecification &dirSpec{x.v};
+ for (const parser::OmpArgument &arg : x.v.Arguments().v) {
+ if (auto *object{GetArgumentObject(arg)}) {
+ CheckSymbolName(dirSpec.source, *object);
+ CheckVarIsNotPartOfAnotherVar(dirSpec.source, *object);
+ CheckThreadprivateOrDeclareTargetVar(*object);
+ }
+ }
dirContext_.pop_back();
}
@@ -1684,30 +1686,35 @@ void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
}
}
-void OmpStructureChecker::CheckSymbolNames(
- const parser::CharBlock &source, const parser::OmpObjectList &objList) {
- for (const auto &ompObject : objList.v) {
- common::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
- if (!name->symbol) {
- context_.Say(source,
- "The given %s directive clause has an invalid argument"_err_en_US,
- ContextDirectiveAsFortran());
- }
- }
- },
- [&](const parser::Name &name) {
- if (!name.symbol) {
+void OmpStructureChecker::CheckSymbolName(
+ const parser::CharBlock &source, const parser::OmpObject &object) {
+ common::visit(
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ if (const auto *name{parser::Unwrap<parser::Name>(object)}) {
+ if (!name->symbol) {
context_.Say(source,
"The given %s directive clause has an invalid argument"_err_en_US,
ContextDirectiveAsFortran());
}
- },
- [&](const parser::OmpObject::Invalid &invalid) {},
- },
- ompObject.u);
+ }
+ },
+ [&](const parser::Name &name) {
+ if (!name.symbol) {
+ context_.Say(source,
+ "The given %s directive clause has an invalid argument"_err_en_US,
+ ContextDirectiveAsFortran());
+ }
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
+ object.u);
+}
+
+void OmpStructureChecker::CheckSymbolNames(
+ const parser::CharBlock &source, const parser::OmpObjectList &objList) {
+ for (const auto &ompObject : objList.v) {
+ CheckSymbolName(source, ompObject);
}
}
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index ce074f5f3f86e..6de69e1a8e4f1 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -228,7 +228,10 @@ class OmpStructureChecker
const parser::OmpObjectList &objList, llvm::StringRef clause = "");
void CheckThreadprivateOrDeclareTargetVar(const parser::Designator &);
void CheckThreadprivateOrDeclareTargetVar(const parser::Name &);
+ void CheckThreadprivateOrDeclareTargetVar(const parser::OmpObject &);
void CheckThreadprivateOrDeclareTargetVar(const parser::OmpObjectList &);
+ void CheckSymbolName(
+ const parser::CharBlock &source, const parser::OmpObject &object);
void CheckSymbolNames(
const parser::CharBlock &source, const parser::OmpObjectList &objList);
void CheckIntentInPointer(SymbolSourceMap &, const llvm::omp::Clause);
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index e75149f21d117..3dff541ffbda0 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -105,6 +105,16 @@ const Symbol *GetObjectSymbol(const parser::OmpObject &object) {
return nullptr;
}
+std::optional<parser::CharBlock> GetObjectSource(
+ const parser::OmpObject &object) {
+ if (auto *name{std::get_if<parser::Name>(&object.u)}) {
+ return name->source;
+ } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
+ return GetLastName(*desg).source;
+ }
+ return std::nullopt;
+}
+
const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument) {
if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
@@ -114,14 +124,12 @@ const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument) {
return nullptr;
}
-std::optional<parser::CharBlock> GetObjectSource(
- const parser::OmpObject &object) {
- if (auto *name{std::get_if<parser::Name>(&object.u)}) {
- return name->source;
- } else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
- return GetLastName(*desg).source;
+const parser::OmpObject *GetArgumentObject(
+ const parser::OmpArgument &argument) {
+ if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
+ return std::get_if<parser::OmpObject>(&locator->u);
}
- return std::nullopt;
+ return nullptr;
}
bool IsCommonBlock(const Symbol &sym) {
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 28c74b8c1908b..c178151b08248 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2344,9 +2344,14 @@ bool OmpAttributeVisitor::Pre(
}
bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
- PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
- const auto &list{std::get<parser::OmpObjectList>(x.t)};
- ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
+ const parser::OmpDirectiveName &dirName{x.v.DirName()};
+ PushContext(dirName.source, dirName.v);
+
+ for (const parser::OmpArgument &arg : x.v.Arguments().v) {
+ if (auto *object{omp::GetArgumentObject(arg)}) {
+ ResolveOmpObject(*object, Symbol::Flag::OmpThreadprivate);
+ }
+ }
return true;
}
>From 991a38f2c0bc861f75d52d4c2d0cfa917ea3ef3f Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 18 Sep 2025 14:42:10 -0500
Subject: [PATCH 4/6] fix MSVC build error
---
flang/lib/Semantics/openmp-utils.cpp | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index e75149f21d117..c62a1b33ed4e8 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -237,7 +237,9 @@ std::optional<bool> IsContiguous(
}
return std::optional<bool>{};
},
- [&](const parser::OmpObject::Invalid &) { return std::nullopt; }},
+ [&](const parser::OmpObject::Invalid &) {
+ return std::optional<bool>{};
+ }},
object.u);
}
>From 7105ce42eb5ead176edb3e28a26eacab3ff59de5 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Mon, 22 Sep 2025 10:06:50 -0500
Subject: [PATCH 5/6] Delete empty line left over after merge
---
flang/lib/Semantics/check-omp-structure.cpp | 1 -
1 file changed, 1 deletion(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 81b98505f24a1..8bcec2f852823 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1685,7 +1685,6 @@ void OmpStructureChecker::CheckSymbolName(
"The given %s directive clause has an invalid argument"_err_en_US,
ContextDirectiveAsFortran());
}
-
}
},
[&](const parser::Name &name) {
>From dde1808e8adae8a275b649c0764450921fe01325 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Mon, 22 Sep 2025 10:22:47 -0500
Subject: [PATCH 6/6] Add parser lit test
---
flang/test/Parser/OpenMP/threadprivate.f90 | 25 ++++++++++++++++++++++
1 file changed, 25 insertions(+)
create mode 100644 flang/test/Parser/OpenMP/threadprivate.f90
diff --git a/flang/test/Parser/OpenMP/threadprivate.f90 b/flang/test/Parser/OpenMP/threadprivate.f90
new file mode 100644
index 0000000000000..69b281f848375
--- /dev/null
+++ b/flang/test/Parser/OpenMP/threadprivate.f90
@@ -0,0 +1,25 @@
+!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=60 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
+!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=60 %s | FileCheck --check-prefix="PARSE-TREE" %s
+
+module m
+implicit none
+integer :: a, b
+common /blk/ a
+
+!$omp threadprivate(/blk/, b)
+
+end module
+
+!UNPARSE: MODULE m
+!UNPARSE: IMPLICIT NONE
+!UNPARSE: INTEGER a, b
+!UNPARSE: COMMON /blk/a
+!UNPARSE: !$OMP THREADPRIVATE(/blk/, b)
+!UNPARSE: END MODULE
+
+!PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPThreadprivate -> OmpDirectiveSpecification
+!PARSE-TREE: | OmpDirectiveName -> llvm::omp::Directive = threadprivate
+!PARSE-TREE: | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Name = 'blk'
+!PARSE-TREE: | OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'b'
+!PARSE-TREE: | OmpClauseList ->
+!PARSE-TREE: | Flags = None
More information about the flang-commits
mailing list