From 73171dd21e3e14bcf0f25e4b5e6e4ab3679ad7d5 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 4 Aug 2025 07:59:47 -0500 Subject: [PATCH 1/6] [flang][OpenMP] Fix crash in unparse-with-symbols for CRITICAL --- flang/lib/Semantics/unparse-with-symbols.cpp | 33 +++++++++++++++++++ .../OpenMP/critical-unparse-with-symbols.f90 | 21 ++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 diff --git a/flang/lib/Semantics/unparse-with-symbols.cpp b/flang/lib/Semantics/unparse-with-symbols.cpp index f1e2e4ea7f119..4548fbeba5df6 100644 --- a/flang/lib/Semantics/unparse-with-symbols.cpp +++ b/flang/lib/Semantics/unparse-with-symbols.cpp @@ -70,6 +70,39 @@ class SymbolDumpVisitor { currStmt_ = std::nullopt; } + bool Pre(const parser::OmpCriticalDirective &x) { + currStmt_ = x.source; + return true; + } + void Post(const parser::OmpCriticalDirective &) { + currStmt_ = std::nullopt; + } + + bool Pre(const parser::OmpEndCriticalDirective &x) { + currStmt_ = x.source; + return true; + } + void Post(const parser::OmpEndCriticalDirective &) { + currStmt_ = std::nullopt; + } + + // Directive arguments can be objects with symbols. + bool Pre(const parser::OmpBeginDirective &x) { + currStmt_ = x.source; + return true; + } + void Post(const parser::OmpBeginDirective &) { + currStmt_ = std::nullopt; + } + + bool Pre(const parser::OmpEndDirective &x) { + currStmt_ = x.source; + return true; + } + void Post(const parser::OmpEndDirective &) { + currStmt_ = std::nullopt; + } + private: std::optional currStmt_; // current statement we are processing std::multimap symbols_; // location to symbol diff --git a/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 b/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 new file mode 100644 index 0000000000000..4d0d93ac48740 --- /dev/null +++ b/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 @@ -0,0 +1,21 @@ +!RUN: %flang_fc1 -fdebug-unparse-with-symbols -fopenmp -fopenmp-version=50 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s + +subroutine f + implicit none + integer :: x + !$omp critical(c) + x = 0 + !$omp end critical(c) +end + +!UNPARSE: !DEF: /f (Subroutine) Subprogram +!UNPARSE: subroutine f +!UNPARSE: implicit none +!UNPARSE: !DEF: /f/x ObjectEntity INTEGER(4) +!UNPARSE: integer x +!UNPARSE: !$omp critical (c) +!UNPARSE: !REF: /f/x +!UNPARSE: x = 0 +!UNPARSE: !$omp end critical (c) +!UNPARSE: end subroutine + From 1b33e0ff393735c84a58d721c929a7fc74909c94 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 4 Aug 2025 08:37:04 -0500 Subject: [PATCH 2/6] format --- flang/lib/Semantics/unparse-with-symbols.cpp | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/flang/lib/Semantics/unparse-with-symbols.cpp b/flang/lib/Semantics/unparse-with-symbols.cpp index 4548fbeba5df6..3093e39ba2411 100644 --- a/flang/lib/Semantics/unparse-with-symbols.cpp +++ b/flang/lib/Semantics/unparse-with-symbols.cpp @@ -74,9 +74,7 @@ class SymbolDumpVisitor { currStmt_ = x.source; return true; } - void Post(const parser::OmpCriticalDirective &) { - currStmt_ = std::nullopt; - } + void Post(const parser::OmpCriticalDirective &) { currStmt_ = std::nullopt; } bool Pre(const parser::OmpEndCriticalDirective &x) { currStmt_ = x.source; @@ -91,17 +89,13 @@ class SymbolDumpVisitor { currStmt_ = x.source; return true; } - void Post(const parser::OmpBeginDirective &) { - currStmt_ = std::nullopt; - } + void Post(const parser::OmpBeginDirective &) { currStmt_ = std::nullopt; } bool Pre(const parser::OmpEndDirective &x) { currStmt_ = x.source; return true; } - void Post(const parser::OmpEndDirective &) { - currStmt_ = std::nullopt; - } + void Post(const parser::OmpEndDirective &) { currStmt_ = std::nullopt; } private: std::optional currStmt_; // current statement we are processing From 4187a39e449369fa8e9b4917e1b2af91ebbb057d Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 4 Aug 2025 11:58:35 -0500 Subject: [PATCH 3/6] [flang][OpenMP] Insert CRITICAL construct names into global scope OpenMP spec (all versions): The names of critical constructs are global entities of the program. If a name conflicts with any other entity, the behavior of the program is unspecified. --- flang/lib/Semantics/resolve-directives.cpp | 9 ---- flang/lib/Semantics/resolve-names.cpp | 44 +++++++++++++++++++ .../OpenMP/critical-global-conflict.f90 | 15 +++++++ .../OpenMP/critical_within_default.f90 | 7 ++- 4 files changed, 65 insertions(+), 10 deletions(-) create mode 100644 flang/test/Semantics/OpenMP/critical-global-conflict.f90 diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index bb28cfb61764f..64bb27962faab 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2125,17 +2125,8 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionConstruct &x) { bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { const auto &beginCriticalDir{std::get(x.t)}; - const auto &endCriticalDir{std::get(x.t)}; PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical); GetContext().withinConstruct = true; - if (const auto &criticalName{ - std::get>(beginCriticalDir.t)}) { - ResolveOmpName(*criticalName, Symbol::Flag::OmpCriticalLock); - } - if (const auto &endCriticalName{ - std::get>(endCriticalDir.t)}) { - ResolveOmpName(*endCriticalName, Symbol::Flag::OmpCriticalLock); - } return true; } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 25b13700cd3ab..86201ebee8bdf 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1593,6 +1593,14 @@ class OmpVisitor : public virtual DeclarationVisitor { } bool Pre(const parser::OmpCriticalDirective &x) { AddOmpSourceRange(x.source); + // Manually resolve names in CRITICAL directives. This is because these + // names do not denote Fortran objects, and the CRITICAL directive causes + // them to be "auto-declared", i.e. inserted into the global scope. + // More specifically, they are not expected to have explicit declarations, + // and if they do the behavior is unspeficied. + if (auto &maybeName{std::get>(x.t)}) { + ResolveCriticalName(*maybeName); + } return true; } void Post(const parser::OmpCriticalDirective &) { @@ -1600,6 +1608,10 @@ class OmpVisitor : public virtual DeclarationVisitor { } bool Pre(const parser::OmpEndCriticalDirective &x) { AddOmpSourceRange(x.source); + // Manually resolve names in CRITICAL directives. + if (auto &maybeName{std::get>(x.t)}) { + ResolveCriticalName(*maybeName); + } return true; } void Post(const parser::OmpEndCriticalDirective &) { @@ -1720,6 +1732,8 @@ class OmpVisitor : public virtual DeclarationVisitor { const std::optional &clauses, const T &wholeConstruct); + void ResolveCriticalName(const parser::Name &name); + int metaLevel_{0}; const parser::OmpMetadirectiveDirective *metaDirective_{nullptr}; }; @@ -1947,6 +1961,36 @@ void OmpVisitor::ProcessReductionSpecifier( } } +void OmpVisitor::ResolveCriticalName(const parser::Name &name) { + auto &globalScope{[&]() -> Scope & { + for (Scope *s{&currScope()};; s = &s->parent()) { + if (s->IsTopLevel()) { + return *s; + } + } + llvm_unreachable("Cannot find global scope"); + }()}; + + auto findSymbol{[&](const parser::Name &n) { + if (auto *s{FindSymbol(n)}) { + return s; + } else { + return FindInScope(globalScope, n); + } + }}; + + if (auto *symbol{findSymbol(name)}) { + if (!symbol->test(Symbol::Flag::OmpCriticalLock)) { + SayWithDecl(name, *symbol, + "CRITICAL construct name '%s' conflicts with a previous declaration"_warn_en_US, + name.ToString()); + } + } else { + name.symbol = &MakeSymbol(globalScope, name.source, Attrs{}); + name.symbol->set(Symbol::Flag::OmpCriticalLock); + } +} + bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) { AddOmpSourceRange(x.source); if (metaLevel_ == 0) { diff --git a/flang/test/Semantics/OpenMP/critical-global-conflict.f90 b/flang/test/Semantics/OpenMP/critical-global-conflict.f90 new file mode 100644 index 0000000000000..cee6f2f14b373 --- /dev/null +++ b/flang/test/Semantics/OpenMP/critical-global-conflict.f90 @@ -0,0 +1,15 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -Werror + +subroutine g +end + +subroutine f(x) + implicit none + integer :: x + +!ERROR: CRITICAL construct name 'f' conflicts with a previous declaration + !$omp critical(f) + x = 0 +!ERROR: CRITICAL construct name 'f' conflicts with a previous declaration + !$omp end critical(f) +end diff --git a/flang/test/Semantics/OpenMP/critical_within_default.f90 b/flang/test/Semantics/OpenMP/critical_within_default.f90 index a5fe30eeb7de0..70353e8e4b585 100644 --- a/flang/test/Semantics/OpenMP/critical_within_default.f90 +++ b/flang/test/Semantics/OpenMP/critical_within_default.f90 @@ -1,11 +1,16 @@ ! RUN: %flang_fc1 -fopenmp -fdebug-dump-symbols %s | FileCheck %s ! Test that we do not make a private copy of the critical name +!CHECK: Global scope: +!CHECK-NEXT: MN: MainProgram +!CHECK-NEXT: k2 (OmpCriticalLock): Unknown + !CHECK: MainProgram scope: MN !CHECK-NEXT: j size=4 offset=0: ObjectEntity type: INTEGER(4) !CHECK-NEXT: OtherConstruct scope: !CHECK-NEXT: j (OmpPrivate): HostAssoc -!CHECK-NEXT: k2 (OmpCriticalLock): Unknown +!CHECK-NOT: k2 + program mn integer :: j j=2 From 6d348e1814f39437630a3a1af977277241f775de Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 4 Aug 2025 12:05:41 -0500 Subject: [PATCH 4/6] Rename name in test --- flang/test/Semantics/OpenMP/critical-global-conflict.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/flang/test/Semantics/OpenMP/critical-global-conflict.f90 b/flang/test/Semantics/OpenMP/critical-global-conflict.f90 index cee6f2f14b373..2546b68748d93 100644 --- a/flang/test/Semantics/OpenMP/critical-global-conflict.f90 +++ b/flang/test/Semantics/OpenMP/critical-global-conflict.f90 @@ -7,9 +7,9 @@ subroutine f(x) implicit none integer :: x -!ERROR: CRITICAL construct name 'f' conflicts with a previous declaration - !$omp critical(f) +!ERROR: CRITICAL construct name 'g' conflicts with a previous declaration + !$omp critical(g) x = 0 -!ERROR: CRITICAL construct name 'f' conflicts with a previous declaration - !$omp end critical(f) +!ERROR: CRITICAL construct name 'g' conflicts with a previous declaration + !$omp end critical(g) end From d57337ec742dd2ace259ab7599b587265723840d Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 4 Aug 2025 07:59:47 -0500 Subject: [PATCH 5/6] [flang][OpenMP] Make OpenMPCriticalConstruct follow block structure This allows not having the END CRITICAL directive in certain situations. Update semantic checks and symbol resolution. --- flang/include/flang/Parser/parse-tree.h | 6 +- .../flang}/Semantics/openmp-utils.h | 0 flang/lib/Lower/OpenMP/OpenMP.cpp | 24 +++- flang/lib/Parser/openmp-parsers.cpp | 13 +- flang/lib/Parser/unparse.cpp | 4 +- flang/lib/Semantics/check-omp-atomic.cpp | 2 +- flang/lib/Semantics/check-omp-loop.cpp | 2 +- .../lib/Semantics/check-omp-metadirective.cpp | 3 +- flang/lib/Semantics/check-omp-structure.cpp | 124 ++++++++++++------ flang/lib/Semantics/openmp-utils.cpp | 2 +- flang/lib/Semantics/resolve-directives.cpp | 6 +- flang/lib/Semantics/resolve-names.cpp | 69 +++++----- flang/lib/Semantics/unparse-with-symbols.cpp | 14 -- .../OpenMP/critical-unparse-with-symbols.f90 | 4 +- .../test/Semantics/OpenMP/sync-critical01.f90 | 8 +- .../test/Semantics/OpenMP/sync-critical02.f90 | 8 +- 16 files changed, 155 insertions(+), 134 deletions(-) rename flang/{lib => include/flang}/Semantics/openmp-utils.h (100%) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 8302e40984af0..e72190f019dd1 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -4986,9 +4986,9 @@ struct OmpEndCriticalDirective { CharBlock source; std::tuple> t; }; -struct OpenMPCriticalConstruct { - TUPLE_CLASS_BOILERPLATE(OpenMPCriticalConstruct); - std::tuple t; + +struct OpenMPCriticalConstruct : public OmpBlockConstruct { + INHERITED_TUPLE_CLASS_BOILERPLATE(OpenMPCriticalConstruct, OmpBlockConstruct); }; // 2.11.3 allocate -> ALLOCATE [(variable-name-list)] [clause] diff --git a/flang/lib/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h similarity index 100% rename from flang/lib/Semantics/openmp-utils.h rename to flang/include/flang/Semantics/openmp-utils.h diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index d1efd8e8d2ca7..f7a7dd8fbe6a0 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -34,6 +34,7 @@ #include "flang/Parser/openmp-utils.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/openmp-directive-sets.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/tools.h" #include "flang/Support/Flags.h" #include "flang/Support/OpenMP-utils.h" @@ -3797,18 +3798,29 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval, const parser::OpenMPCriticalConstruct &criticalConstruct) { - const auto &cd = std::get(criticalConstruct.t); - List clauses = - makeClauses(std::get(cd.t), semaCtx); + const parser::OmpDirectiveSpecification &beginSpec = + criticalConstruct.BeginDir(); + List clauses = makeClauses(beginSpec.Clauses(), semaCtx); ConstructQueue queue{buildConstructQueue( - converter.getFirOpBuilder().getModule(), semaCtx, eval, cd.source, + converter.getFirOpBuilder().getModule(), semaCtx, eval, beginSpec.source, llvm::omp::Directive::OMPD_critical, clauses)}; - const auto &name = std::get>(cd.t); + std::optional critName; + const parser::OmpArgumentList &args = beginSpec.Arguments(); + if (!args.v.empty()) { + // All of these things should be guaranteed to exist after semantic checks. + auto *object = parser::Unwrap(args.v.front()); + assert(object && "Expecting object as argument"); + auto *designator = semantics::omp::GetDesignatorFromObj(*object); + assert(designator && "Expecting desginator in argument"); + auto *name = semantics::getDesignatorNameIfDataRef(*designator); + assert(name && "Expecting dataref in designator"); + critName = *name; + } mlir::Location currentLocation = converter.getCurrentLocation(); genCriticalOp(converter, symTable, semaCtx, eval, currentLocation, queue, - queue.begin(), name); + queue.begin(), critName); } static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp index 84d1e81bfd9be..ab23e7d70de4f 100644 --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -1758,17 +1758,8 @@ TYPE_PARSER(sourced(construct( TYPE_PARSER(construct(Parser{}) || construct(Parser{})) -// 2.13.2 OMP CRITICAL -TYPE_PARSER(startOmpLine >> - sourced(construct( - verbatim("END CRITICAL"_tok), maybe(parenthesized(name)))) / - endOmpLine) -TYPE_PARSER(sourced(construct(verbatim("CRITICAL"_tok), - maybe(parenthesized(name)), Parser{})) / - endOmpLine) - -TYPE_PARSER(construct( - Parser{}, block, Parser{})) +TYPE_PARSER(construct(OmpBlockConstructParser{ + llvm::omp::Directive::OMPD_critical})) // 2.11.3 Executable Allocate directive TYPE_PARSER( diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index 46141e2ccab56..4f8d498972807 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2606,9 +2606,7 @@ class UnparseVisitor { EndOpenMP(); } void Unparse(const OpenMPCriticalConstruct &x) { - Walk(std::get(x.t)); - Walk(std::get(x.t), ""); - Walk(std::get(x.t)); + Unparse(static_cast(x)); } void Unparse(const OmpDeclareTargetWithList &x) { Put("("), Walk(x.v), Put(")"); diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp index a5fdabf0b103c..fcb0f9ad1e25d 100644 --- a/flang/lib/Semantics/check-omp-atomic.cpp +++ b/flang/lib/Semantics/check-omp-atomic.cpp @@ -11,13 +11,13 @@ //===----------------------------------------------------------------------===// #include "check-omp-structure.h" -#include "openmp-utils.h" #include "flang/Common/indirection.h" #include "flang/Evaluate/expression.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/char-block.h" #include "flang/Parser/parse-tree.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/symbol.h" #include "flang/Semantics/tools.h" #include "flang/Semantics/type.h" diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp index 59d57a2ec7cfb..8dad1f5d605e7 100644 --- a/flang/lib/Semantics/check-omp-loop.cpp +++ b/flang/lib/Semantics/check-omp-loop.cpp @@ -13,7 +13,6 @@ #include "check-omp-structure.h" #include "check-directive-structure.h" -#include "openmp-utils.h" #include "flang/Common/idioms.h" #include "flang/Common/visit.h" @@ -23,6 +22,7 @@ #include "flang/Parser/parse-tree.h" #include "flang/Parser/tools.h" #include "flang/Semantics/openmp-modifiers.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/symbol.h" #include "flang/Semantics/tools.h" diff --git a/flang/lib/Semantics/check-omp-metadirective.cpp b/flang/lib/Semantics/check-omp-metadirective.cpp index 03487da64f1bf..cf5ea9028edc7 100644 --- a/flang/lib/Semantics/check-omp-metadirective.cpp +++ b/flang/lib/Semantics/check-omp-metadirective.cpp @@ -12,8 +12,6 @@ #include "check-omp-structure.h" -#include "openmp-utils.h" - #include "flang/Common/idioms.h" #include "flang/Common/indirection.h" #include "flang/Common/visit.h" @@ -21,6 +19,7 @@ #include "flang/Parser/message.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/openmp-modifiers.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/tools.h" #include "llvm/Frontend/OpenMP/OMP.h" diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index a9c56c347877f..cbe6b2c68bf05 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -10,7 +10,6 @@ #include "check-directive-structure.h" #include "definable.h" -#include "openmp-utils.h" #include "resolve-names-utils.h" #include "flang/Common/idioms.h" @@ -27,6 +26,7 @@ #include "flang/Semantics/expression.h" #include "flang/Semantics/openmp-directive-sets.h" #include "flang/Semantics/openmp-modifiers.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/scope.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/symbol.h" @@ -537,14 +537,6 @@ template struct DirectiveSpellingVisitor { checker_(x.v.source, Directive::OMPD_assume); return false; } - bool Pre(const parser::OmpCriticalDirective &x) { - checker_(std::get(x.t).source, Directive::OMPD_critical); - return false; - } - bool Pre(const parser::OmpEndCriticalDirective &x) { - checker_(std::get(x.t).source, Directive::OMPD_critical); - return false; - } bool Pre(const parser::OmpMetadirectiveDirective &x) { checker_( std::get(x.t).source, Directive::OMPD_metadirective); @@ -2034,41 +2026,87 @@ void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) { } void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { - const auto &dir{std::get(x.t)}; - const auto &dirSource{std::get(dir.t).source}; - const auto &endDir{std::get(x.t)}; - PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical); + const parser::OmpBeginDirective &beginSpec{x.BeginDir()}; + const std::optional &endSpec{x.EndDir()}; + PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirName().v); + const auto &block{std::get(x.t)}; - CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); - const auto &dirName{std::get>(dir.t)}; - const auto &endDirName{std::get>(endDir.t)}; - const auto &ompClause{std::get(dir.t)}; - if (dirName && endDirName && - dirName->ToString().compare(endDirName->ToString())) { - context_ - .Say(endDirName->source, - parser::MessageFormattedText{ - "CRITICAL directive names do not match"_err_en_US}) - .Attach(dirName->source, "should be "_en_US); - } else if (dirName && !endDirName) { - context_ - .Say(dirName->source, - parser::MessageFormattedText{ - "CRITICAL directive names do not match"_err_en_US}) - .Attach(dirName->source, "should be NULL"_en_US); - } else if (!dirName && endDirName) { - context_ - .Say(endDirName->source, - parser::MessageFormattedText{ - "CRITICAL directive names do not match"_err_en_US}) - .Attach(endDirName->source, "should be NULL"_en_US); - } - if (!dirName && !ompClause.source.empty() && - ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") { - context_.Say(dir.source, - parser::MessageFormattedText{ - "Hint clause other than omp_sync_hint_none cannot be specified for " - "an unnamed CRITICAL directive"_err_en_US}); + CheckNoBranching( + block, llvm::omp::Directive::OMPD_critical, beginSpec.DirName().source); + + auto getNameFromArg{[](const parser::OmpArgument &arg) { + if (auto *object{parser::Unwrap(arg.u)}) { + if (auto *designator{omp::GetDesignatorFromObj(*object)}) { + return getDesignatorNameIfDataRef(*designator); + } + } + return static_cast(nullptr); + }}; + + auto checkArgumentList{[&](const parser::OmpArgumentList &args) { + if (args.v.size() > 1) { + context_.Say(args.source, + "Only a single argument is allowed in CRITICAL directive"_err_en_US); + } else if (!args.v.empty()) { + if (!getNameFromArg(args.v.front())) { + context_.Say(args.v.front().source, + "CRITICAL argument should be a name"_err_en_US); + } + } + }}; + + const parser::Name *beginName{nullptr}; + const parser::Name *endName{nullptr}; + + auto &beginArgs{beginSpec.Arguments()}; + checkArgumentList(beginArgs); + + if (!beginArgs.v.empty()) { + beginName = getNameFromArg(beginArgs.v.front()); + } + + if (endSpec) { + auto &endArgs{endSpec->Arguments()}; + checkArgumentList(endArgs); + + if (beginArgs.v.empty() != endArgs.v.empty()) { + parser::CharBlock source{ + beginArgs.v.empty() ? endArgs.source : beginArgs.source}; + context_.Say(source, + "Either both CRITICAL and END CRITICAL should have an argument, or none of them should"_err_en_US); + } else if (!beginArgs.v.empty()) { + endName = getNameFromArg(endArgs.v.front()); + if (beginName && endName) { + if (beginName->ToString() != endName->ToString()) { + context_.Say(endName->source, + "The names on CRITICAL and END CRITICAL must match"_err_en_US); + } + } + } + } + + for (auto &clause : beginSpec.Clauses().v) { + auto *hint{std::get_if(&clause.u)}; + if (!hint) { + continue; + } + const int64_t OmpSyncHintNone = 0; // omp_sync_hint_none + std::optional hintValue{GetIntValue(hint->v.v)}; + if (hintValue && *hintValue != OmpSyncHintNone) { + // Emit a diagnostic if the name is missing, and point to the directive + // with a missing name. + parser::CharBlock source; + if (!beginName) { + source = beginSpec.DirName().source; + } else if (endSpec && !endName) { + source = endSpec->DirName().source; + } + + if (!source.empty()) { + context_.Say(source, + "When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name"_err_en_US); + } + } } } diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index 7a492a4378907..e8df346ccdc3e 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -10,7 +10,7 @@ // //===----------------------------------------------------------------------===// -#include "openmp-utils.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Common/indirection.h" #include "flang/Common/reference.h" diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 64bb27962faab..7110f607508e7 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -10,7 +10,6 @@ #include "check-acc-structure.h" #include "check-omp-structure.h" -#include "openmp-utils.h" #include "resolve-names-utils.h" #include "flang/Common/idioms.h" #include "flang/Evaluate/fold.h" @@ -22,6 +21,7 @@ #include "flang/Semantics/expression.h" #include "flang/Semantics/openmp-dsa.h" #include "flang/Semantics/openmp-modifiers.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/symbol.h" #include "flang/Semantics/tools.h" #include "llvm/Frontend/OpenMP/OMP.h.inc" @@ -2124,8 +2124,8 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionConstruct &x) { } bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { - const auto &beginCriticalDir{std::get(x.t)}; - PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical); + const parser::OmpBeginDirective &beginSpec{x.BeginDir()}; + PushContext(beginSpec.DirName().source, beginSpec.DirName().v); GetContext().withinConstruct = true; return true; } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 86201ebee8bdf..f066025354253 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -30,6 +30,7 @@ #include "flang/Semantics/attr.h" #include "flang/Semantics/expression.h" #include "flang/Semantics/openmp-modifiers.h" +#include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/program-tree.h" #include "flang/Semantics/scope.h" #include "flang/Semantics/semantics.h" @@ -1486,6 +1487,16 @@ class OmpVisitor : public virtual DeclarationVisitor { void Post(const parser::OpenMPBlockConstruct &); bool Pre(const parser::OmpBeginDirective &x) { AddOmpSourceRange(x.source); + // Manually resolve names in CRITICAL directives. This is because these + // names do not denote Fortran objects, and the CRITICAL directive causes + // them to be "auto-declared", i.e. inserted into the global scope. + // More specifically, they are not expected to have explicit declarations, + // and if they do the behavior is unspeficied. + if (x.DirName().v == llvm::omp::Directive::OMPD_critical) { + for (const parser::OmpArgument &arg : x.Arguments().v) { + ResolveCriticalName(arg); + } + } return true; } void Post(const parser::OmpBeginDirective &) { @@ -1493,6 +1504,12 @@ class OmpVisitor : public virtual DeclarationVisitor { } bool Pre(const parser::OmpEndDirective &x) { AddOmpSourceRange(x.source); + // Manually resolve names in CRITICAL directives. + if (x.DirName().v == llvm::omp::Directive::OMPD_critical) { + for (const parser::OmpArgument &arg : x.Arguments().v) { + ResolveCriticalName(arg); + } + } return true; } void Post(const parser::OmpEndDirective &) { @@ -1591,32 +1608,6 @@ class OmpVisitor : public virtual DeclarationVisitor { void Post(const parser::OmpEndSectionsDirective &) { messageHandler().set_currStmtSource(std::nullopt); } - bool Pre(const parser::OmpCriticalDirective &x) { - AddOmpSourceRange(x.source); - // Manually resolve names in CRITICAL directives. This is because these - // names do not denote Fortran objects, and the CRITICAL directive causes - // them to be "auto-declared", i.e. inserted into the global scope. - // More specifically, they are not expected to have explicit declarations, - // and if they do the behavior is unspeficied. - if (auto &maybeName{std::get>(x.t)}) { - ResolveCriticalName(*maybeName); - } - return true; - } - void Post(const parser::OmpCriticalDirective &) { - messageHandler().set_currStmtSource(std::nullopt); - } - bool Pre(const parser::OmpEndCriticalDirective &x) { - AddOmpSourceRange(x.source); - // Manually resolve names in CRITICAL directives. - if (auto &maybeName{std::get>(x.t)}) { - ResolveCriticalName(*maybeName); - } - return true; - } - void Post(const parser::OmpEndCriticalDirective &) { - messageHandler().set_currStmtSource(std::nullopt); - } bool Pre(const parser::OpenMPThreadprivate &) { SkipImplicitTyping(true); return true; @@ -1732,7 +1723,7 @@ class OmpVisitor : public virtual DeclarationVisitor { const std::optional &clauses, const T &wholeConstruct); - void ResolveCriticalName(const parser::Name &name); + void ResolveCriticalName(const parser::OmpArgument &arg); int metaLevel_{0}; const parser::OmpMetadirectiveDirective *metaDirective_{nullptr}; @@ -1961,7 +1952,7 @@ void OmpVisitor::ProcessReductionSpecifier( } } -void OmpVisitor::ResolveCriticalName(const parser::Name &name) { +void OmpVisitor::ResolveCriticalName(const parser::OmpArgument &arg) { auto &globalScope{[&]() -> Scope & { for (Scope *s{&currScope()};; s = &s->parent()) { if (s->IsTopLevel()) { @@ -1979,15 +1970,21 @@ void OmpVisitor::ResolveCriticalName(const parser::Name &name) { } }}; - if (auto *symbol{findSymbol(name)}) { - if (!symbol->test(Symbol::Flag::OmpCriticalLock)) { - SayWithDecl(name, *symbol, - "CRITICAL construct name '%s' conflicts with a previous declaration"_warn_en_US, - name.ToString()); + if (auto *object{parser::Unwrap(arg.u)}) { + if (auto *desg{omp::GetDesignatorFromObj(*object)}) { + if (auto *name{getDesignatorNameIfDataRef(*desg)}) { + if (auto *symbol{findSymbol(*name)}) { + if (!symbol->test(Symbol::Flag::OmpCriticalLock)) { + SayWithDecl(*name, *symbol, + "CRITICAL construct name '%s' conflicts with a previous declaration"_warn_en_US, + name->ToString()); + } + } else { + name->symbol = &MakeSymbol(globalScope, name->source, Attrs{}); + name->symbol->set(Symbol::Flag::OmpCriticalLock); + } + } } - } else { - name.symbol = &MakeSymbol(globalScope, name.source, Attrs{}); - name.symbol->set(Symbol::Flag::OmpCriticalLock); } } diff --git a/flang/lib/Semantics/unparse-with-symbols.cpp b/flang/lib/Semantics/unparse-with-symbols.cpp index 3093e39ba2411..41077e0e0aad7 100644 --- a/flang/lib/Semantics/unparse-with-symbols.cpp +++ b/flang/lib/Semantics/unparse-with-symbols.cpp @@ -70,20 +70,6 @@ class SymbolDumpVisitor { currStmt_ = std::nullopt; } - bool Pre(const parser::OmpCriticalDirective &x) { - currStmt_ = x.source; - return true; - } - void Post(const parser::OmpCriticalDirective &) { currStmt_ = std::nullopt; } - - bool Pre(const parser::OmpEndCriticalDirective &x) { - currStmt_ = x.source; - return true; - } - void Post(const parser::OmpEndCriticalDirective &) { - currStmt_ = std::nullopt; - } - // Directive arguments can be objects with symbols. bool Pre(const parser::OmpBeginDirective &x) { currStmt_ = x.source; diff --git a/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 b/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 index 4d0d93ac48740..e5e7561d4f63e 100644 --- a/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 +++ b/flang/test/Parser/OpenMP/critical-unparse-with-symbols.f90 @@ -13,9 +13,9 @@ subroutine f !UNPARSE: implicit none !UNPARSE: !DEF: /f/x ObjectEntity INTEGER(4) !UNPARSE: integer x -!UNPARSE: !$omp critical (c) +!UNPARSE: !$omp critical(c) !UNPARSE: !REF: /f/x !UNPARSE: x = 0 -!UNPARSE: !$omp end critical (c) +!UNPARSE: !$omp end critical(c) !UNPARSE: end subroutine diff --git a/flang/test/Semantics/OpenMP/sync-critical01.f90 b/flang/test/Semantics/OpenMP/sync-critical01.f90 index b597eb17ea226..01cc0acf65936 100644 --- a/flang/test/Semantics/OpenMP/sync-critical01.f90 +++ b/flang/test/Semantics/OpenMP/sync-critical01.f90 @@ -17,22 +17,22 @@ integer function timer_tick_sec() !$OMP CRITICAL (foo) t = t + 1 - !ERROR: CRITICAL directive names do not match + !ERROR: The names on CRITICAL and END CRITICAL must match !$OMP END CRITICAL (bar) !$OMP CRITICAL (bar) t = t + 1 - !ERROR: CRITICAL directive names do not match + !ERROR: The names on CRITICAL and END CRITICAL must match !$OMP END CRITICAL (foo) - !ERROR: CRITICAL directive names do not match + !ERROR: Either both CRITICAL and END CRITICAL should have an argument, or none of them should !$OMP CRITICAL (bar) t = t + 1 !$OMP END CRITICAL !$OMP CRITICAL t = t + 1 - !ERROR: CRITICAL directive names do not match + !ERROR: Either both CRITICAL and END CRITICAL should have an argument, or none of them should !$OMP END CRITICAL (foo) timer_tick_sec = t diff --git a/flang/test/Semantics/OpenMP/sync-critical02.f90 b/flang/test/Semantics/OpenMP/sync-critical02.f90 index 1fa9d6ad84f28..b77bd66aac5f8 100644 --- a/flang/test/Semantics/OpenMP/sync-critical02.f90 +++ b/flang/test/Semantics/OpenMP/sync-critical02.f90 @@ -8,7 +8,7 @@ program sample use omp_lib integer i, j - !ERROR: Hint clause other than omp_sync_hint_none cannot be specified for an unnamed CRITICAL directive + !ERROR: When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name !$omp critical hint(omp_lock_hint_speculative) j = j + 1 !$omp end critical @@ -17,7 +17,7 @@ program sample i = i - 1 !$omp end critical (foo) - !ERROR: Hint clause other than omp_sync_hint_none cannot be specified for an unnamed CRITICAL directive + !ERROR: When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name !$omp critical hint(omp_lock_hint_nonspeculative) j = j + 1 !$omp end critical @@ -26,7 +26,7 @@ program sample i = i - 1 !$omp end critical (foo) - !ERROR: Hint clause other than omp_sync_hint_none cannot be specified for an unnamed CRITICAL directive + !ERROR: When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name !$omp critical hint(omp_lock_hint_contended) j = j + 1 !$omp end critical @@ -35,7 +35,7 @@ program sample i = i - 1 !$omp end critical (foo) - !ERROR: Hint clause other than omp_sync_hint_none cannot be specified for an unnamed CRITICAL directive + !ERROR: When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name !$omp critical hint(omp_lock_hint_uncontended) j = j + 1 !$omp end critical From 41176e004c7cc39dec3e71018de49fc93e747953 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 4 Aug 2025 12:45:23 -0500 Subject: [PATCH 6/6] format --- flang/lib/Parser/openmp-parsers.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp index ab23e7d70de4f..46b14861096f1 100644 --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -1758,8 +1758,8 @@ TYPE_PARSER(sourced(construct( TYPE_PARSER(construct(Parser{}) || construct(Parser{})) -TYPE_PARSER(construct(OmpBlockConstructParser{ - llvm::omp::Directive::OMPD_critical})) +TYPE_PARSER(construct( + OmpBlockConstructParser{llvm::omp::Directive::OMPD_critical})) // 2.11.3 Executable Allocate directive TYPE_PARSER(