[flang-commits] [flang] [flang][OpenMP] Make OpenMPCriticalConstruct follow block structure (PR #152007)
Krzysztof Parzyszek via flang-commits
flang-commits at lists.llvm.org
Wed Aug 6 08:21:49 PDT 2025
https://github.com/kparzysz updated https://github.com/llvm/llvm-project/pull/152007
>From 73171dd21e3e14bcf0f25e4b5e6e4ab3679ad7d5 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
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<SourceName> currStmt_; // current statement we are processing
std::multimap<const char *, const Symbol *> 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 <Krzysztof.Parzyszek at amd.com>
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<SourceName> currStmt_; // current statement we are processing
>From 4187a39e449369fa8e9b4917e1b2af91ebbb057d Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
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<parser::OmpCriticalDirective>(x.t)};
- const auto &endCriticalDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical);
GetContext().withinConstruct = true;
- if (const auto &criticalName{
- std::get<std::optional<parser::Name>>(beginCriticalDir.t)}) {
- ResolveOmpName(*criticalName, Symbol::Flag::OmpCriticalLock);
- }
- if (const auto &endCriticalName{
- std::get<std::optional<parser::Name>>(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<std::optional<parser::Name>>(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<std::optional<parser::Name>>(x.t)}) {
+ ResolveCriticalName(*maybeName);
+ }
return true;
}
void Post(const parser::OmpEndCriticalDirective &) {
@@ -1720,6 +1732,8 @@ class OmpVisitor : public virtual DeclarationVisitor {
const std::optional<parser::OmpClauseList> &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 <Krzysztof.Parzyszek at amd.com>
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 <Krzysztof.Parzyszek at amd.com>
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<Verbatim, std::optional<Name>> t;
};
-struct OpenMPCriticalConstruct {
- TUPLE_CLASS_BOILERPLATE(OpenMPCriticalConstruct);
- std::tuple<OmpCriticalDirective, Block, OmpEndCriticalDirective> 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<parser::OmpCriticalDirective>(criticalConstruct.t);
- List<Clause> clauses =
- makeClauses(std::get<parser::OmpClauseList>(cd.t), semaCtx);
+ const parser::OmpDirectiveSpecification &beginSpec =
+ criticalConstruct.BeginDir();
+ List<Clause> 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<std::optional<parser::Name>>(cd.t);
+ std::optional<parser::Name> 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<parser::OmpObject>(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<OpenMPDeclareMapperConstruct>(
TYPE_PARSER(construct<OmpReductionCombiner>(Parser<AssignmentStmt>{}) ||
construct<OmpReductionCombiner>(Parser<FunctionReference>{}))
-// 2.13.2 OMP CRITICAL
-TYPE_PARSER(startOmpLine >>
- sourced(construct<OmpEndCriticalDirective>(
- verbatim("END CRITICAL"_tok), maybe(parenthesized(name)))) /
- endOmpLine)
-TYPE_PARSER(sourced(construct<OmpCriticalDirective>(verbatim("CRITICAL"_tok),
- maybe(parenthesized(name)), Parser<OmpClauseList>{})) /
- endOmpLine)
-
-TYPE_PARSER(construct<OpenMPCriticalConstruct>(
- Parser<OmpCriticalDirective>{}, block, Parser<OmpEndCriticalDirective>{}))
+TYPE_PARSER(construct<OpenMPCriticalConstruct>(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<OmpCriticalDirective>(x.t));
- Walk(std::get<Block>(x.t), "");
- Walk(std::get<OmpEndCriticalDirective>(x.t));
+ Unparse(static_cast<const OmpBlockConstruct &>(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 <typename Checker> struct DirectiveSpellingVisitor {
checker_(x.v.source, Directive::OMPD_assume);
return false;
}
- bool Pre(const parser::OmpCriticalDirective &x) {
- checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
- return false;
- }
- bool Pre(const parser::OmpEndCriticalDirective &x) {
- checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
- return false;
- }
bool Pre(const parser::OmpMetadirectiveDirective &x) {
checker_(
std::get<parser::Verbatim>(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<parser::OmpCriticalDirective>(x.t)};
- const auto &dirSource{std::get<parser::Verbatim>(dir.t).source};
- const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
- PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical);
+ const parser::OmpBeginDirective &beginSpec{x.BeginDir()};
+ const std::optional<parser::OmpEndDirective> &endSpec{x.EndDir()};
+ PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirName().v);
+
const auto &block{std::get<parser::Block>(x.t)};
- CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
- const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
- const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
- const auto &ompClause{std::get<parser::OmpClauseList>(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<parser::OmpObject>(arg.u)}) {
+ if (auto *designator{omp::GetDesignatorFromObj(*object)}) {
+ return getDesignatorNameIfDataRef(*designator);
+ }
+ }
+ return static_cast<const parser::Name *>(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<parser::OmpClause::Hint>(&clause.u)};
+ if (!hint) {
+ continue;
+ }
+ const int64_t OmpSyncHintNone = 0; // omp_sync_hint_none
+ std::optional<int64_t> 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<parser::OmpCriticalDirective>(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<std::optional<parser::Name>>(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<std::optional<parser::Name>>(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<parser::OmpClauseList> &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<parser::OmpObject>(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 <Krzysztof.Parzyszek at amd.com>
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<OpenMPDeclareMapperConstruct>(
TYPE_PARSER(construct<OmpReductionCombiner>(Parser<AssignmentStmt>{}) ||
construct<OmpReductionCombiner>(Parser<FunctionReference>{}))
-TYPE_PARSER(construct<OpenMPCriticalConstruct>(OmpBlockConstructParser{
- llvm::omp::Directive::OMPD_critical}))
+TYPE_PARSER(construct<OpenMPCriticalConstruct>(
+ OmpBlockConstructParser{llvm::omp::Directive::OMPD_critical}))
// 2.11.3 Executable Allocate directive
TYPE_PARSER(
More information about the flang-commits
mailing list