[flang][OpenMP] Fix threadprivate common blocks

[luporl]

Using a threadprivate common block within a nested scope resulted
in compilation errors.

This happened because common block names were being first resolved
to those in the parent scope. Because of this, in a nested scope,
an inner threadprivate directive would be applied to the outter
common block. This caused a 'common_block appears in more than one
data-sharing clause' error.

Also, when a copyin clause in a parallel region tried to use the
common block, getting the inner version of it, their objects would
be missing the threadprivate attribute, causing a 'Non-THREADPRIVATE
object in COPYIN clause' error.

Fixes #61200

[llvmbot]

@llvm/pr-subscribers-flang-openmp

@llvm/pr-subscribers-flang-semantics

Author: Leandro Lupori (luporl)

Changes

Using a threadprivate common block within a nested scope resulted
in compilation errors.

This happened because common block names were being first resolved
to those in the parent scope. Because of this, in a nested scope,
an inner threadprivate directive would be applied to the outter
common block. This caused a 'common_block appears in more than one
data-sharing clause' error.

Also, when a copyin clause in a parallel region tried to use the
common block, getting the inner version of it, their objects would
be missing the threadprivate attribute, causing a 'Non-THREADPRIVATE
object in COPYIN clause' error.

Fixes #61200

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/resolve-directives.cpp (+10-9)
• (added) flang/test/Semantics/OpenMP/threadprivate06.f90 (+30)

diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 794a78408863cb3..117d4cbb8ad0cbc 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1944,18 +1944,19 @@ void OmpAttributeVisitor::ResolveOmpNameList(
 
 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
     const parser::Name *name) {
-  if (auto *prev{name
-              ? GetContext().scope.parent().FindCommonBlock(name->source)
-              : nullptr}) {
+  if (!name) {
+    return nullptr;
+  }
+  // First check if the Common Block is declared in the current scope
+  if (auto *cur{GetContext().scope.FindCommonBlock(name->source)}) {
+    name->symbol = cur;
+    return cur;
+  }
+  // Then check parent scope
+  if (auto *prev{GetContext().scope.parent().FindCommonBlock(name->source)}) {
     name->symbol = prev;
     return prev;
   }
-  // Check if the Common Block is declared in the current scope
-  if (auto *commonBlockSymbol{
-          name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
-    name->symbol = commonBlockSymbol;
-    return commonBlockSymbol;
-  }
   return nullptr;
 }
 
diff --git a/flang/test/Semantics/OpenMP/threadprivate06.f90 b/flang/test/Semantics/OpenMP/threadprivate06.f90
new file mode 100644
index 000000000000000..f31c38f6f2b248f
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/threadprivate06.f90
@@ -0,0 +1,30 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
+! OpenMP Version 5.1
+! Check OpenMP construct validity for the following directives:
+! 2.21.2 Threadprivate Directive
+
+program main
+  call sub1()
+  print *, 'pass'
+end program main
+
+subroutine sub1()
+  common /c/ a
+  !$omp threadprivate(/c/)
+  integer :: a
+
+  a = 100
+  call sub2()
+  if (a .ne. 101) print *, 'err'
+
+contains
+  subroutine sub2()
+    common /c/ a
+    !$omp threadprivate(/c/)
+    integer :: a
+
+    !$omp parallel copyin(/c/)
+      a = a + 1
+    !$omp end parallel
+  end subroutine
+end subroutine

[kiranchandramohan]

LGTM. Thanks @luporl for the fix.
I wonder why the initial code looked at the parent scope only.

[luporl]

Thanks @kiranchandramohan for the review.
By looking at git's history, it seems that initially ResolveOmpCommonBlockName was used with OpenMP regions only, such as parallel, but later it started being used with threadprivate, that needs to search the current scope.