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

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;
 }
 

flang/lib/Semantics/resolve-names.cpp

@@ -1593,13 +1593,25 @@ 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 &) {
     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 &) {
@@ -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) {

flang/lib/Semantics/unparse-with-symbols.cpp

@@ -70,6 +70,33 @@ 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

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
+

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

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