[flang][OpenMP] Insert CRITICAL construct names into global scope

[kparzysz]

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.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-openmp

Author: Krzysztof Parzyszek (kparzysz)

Changes

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.

---

Full diff: https://github.com/llvm/llvm-project/pull/152004.diff

4 Files Affected:

• (modified) flang/lib/Semantics/resolve-directives.cpp (-9)
• (modified) flang/lib/Semantics/resolve-names.cpp (+44)
• (added) flang/test/Semantics/OpenMP/critical-global-conflict.f90 (+15)
• (modified) flang/test/Semantics/OpenMP/critical_within_default.f90 (+6-1)

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