[flang-commits] [flang] 1d23005 - [flang][OpenMP] Insert CRITICAL construct names into global scope (#152004)

[via flang-commits]

Author: Krzysztof Parzyszek
Date: 2025-08-06T10:16:43-05:00
New Revision: 1d23005b8e2ef3494d9beb1812205bd1386e77fc

URL: https://github.com/llvm/llvm-project/commit/1d23005b8e2ef3494d9beb1812205bd1386e77fc
DIFF: https://github.com/llvm/llvm-project/commit/1d23005b8e2ef3494d9beb1812205bd1386e77fc.diff

LOG: [flang][OpenMP] Insert CRITICAL construct names into global scope (#152004)

They were inserted in the current 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.

Added: 
    flang/test/Semantics/OpenMP/critical-global-conflict.f90

Modified: 
    flang/lib/Semantics/resolve-directives.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/OpenMP/critical_within_default.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index f08c77352f567..0557b0870de2f 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2140,17 +2140,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..66a45dd3d07fa 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,28 @@ 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");
+  }()};
+
+  if (auto *symbol{FindInScope(globalScope, 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..2546b68748d93
--- /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 'g' conflicts with a previous declaration
+  !$omp critical(g)
+  x = 0
+!ERROR: CRITICAL construct name 'g' conflicts with a previous declaration
+  !$omp end critical(g)
+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