From b34629f252da8079829d92eaef33837b46963636 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek 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 u; + std::variant u; }; WRAPPER_CLASS(OmpObjectList, std::list); 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( maybe(nonemptyList(Parser{}) / ":"), scalarIntExpr)) -TYPE_PARSER( - construct(designator) || "/" >> construct(name) / "/") +TYPE_PARSER( // + construct(designator) || + "/" >> construct(name) / "/" || + construct(sourced(construct( + "//"_tok >> pure(OmpObject::Invalid::Kind::BlankCommonBlock))))) // OMP 5.0 2.19.4.5 LASTPRIVATE ([lastprivate-modifier :] list) TYPE_PARSER(construct( 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(object.u)) { + if (std::holds_alternative(object.u) || + std::holds_alternative(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(nullptr); + }, + }, + obj.u); }}; auto getArgSymbol{[&](const parser::OmpArgument &arg) { if (auto *locator{std::get_if(&arg.u)}) { @@ -1450,9 +1467,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) { if (const std::optional &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 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{true}; @@ -237,7 +237,7 @@ std::optional IsContiguous( } return std::optional{}; }, - }, + [&](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(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(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 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 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 || std::is_same_v || std::is_same_v || - std::is_same_v || - std::is_same_v) { + std::is_same_v) { return MakeName(std::get(x.t).source, ConstructId::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 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 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( verbatim("REQUIRES"_tok), Parser{}))) // 2.15.2 Threadprivate directive -TYPE_PARSER(sourced(construct( - verbatim("THREADPRIVATE"_tok), parenthesized(Parser{})))) +TYPE_PARSER(sourced( // + construct( + predicated(OmpDirectiveNameParser{}, + IsDirective(llvm::omp::Directive::OMPD_threadprivate)) >= + Parser{}))) // 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(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 struct DirectiveSpellingVisitor { checker_(x.v.DirName().source, Directive::OMPD_groupprivate); return false; } - bool Pre(const parser::OpenMPThreadprivate &x) { - checker_( - std::get(x.t).source, Directive::OMPD_threadprivate); - return false; - } bool Pre(const parser::OpenMPRequiresConstruct &x) { checker_(std::get(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(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(c.t)}; - const auto &objectList{std::get(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(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(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 GetObjectSource( + const parser::OmpObject &object) { + if (auto *name{std::get_if(&object.u)}) { + return name->source; + } else if (auto *desg{std::get_if(&object.u)}) { + return GetLastName(*desg).source; + } + return std::nullopt; +} + const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument) { if (auto *locator{std::get_if(&argument.u)}) { if (auto *object{std::get_if(&locator->u)}) { @@ -114,14 +124,12 @@ const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument) { return nullptr; } -std::optional GetObjectSource( - const parser::OmpObject &object) { - if (auto *name{std::get_if(&object.u)}) { - return name->source; - } else if (auto *desg{std::get_if(&object.u)}) { - return GetLastName(*desg).source; +const parser::OmpObject *GetArgumentObject( + const parser::OmpArgument &argument) { + if (auto *locator{std::get_if(&argument.u)}) { + return std::get_if(&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(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 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 IsContiguous( } return std::optional{}; }, - [&](const parser::OmpObject::Invalid &) { return std::nullopt; }}, + [&](const parser::OmpObject::Invalid &) { + return std::optional{}; + }}, object.u); } From 7105ce42eb5ead176edb3e28a26eacab3ff59de5 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek 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 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