[flang-commits] [flang] [Flang][OpenMP} Permit THREADPRIVATE variables in EQUIVALENCE statements (PR #186696)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Michael Klemm (mjklemm)

<details>
<summary>Changes</summary>

The OpenMP API does not allow to have THREADPRIVATE variable appear in an EQUIVALENCE statement.  It has been requested by the community to extend Flang such that it permits these non-conforming patterns.  This PR changes Flang to inherit the DSA of the base object of the EQUIVALENCE statement to the equivalenced variables.  The orginal error message is turned into a warning.

Fixes https://github.com/llvm/llvm-project/issues/180493

Assisted-by: Claude Code, Opus 4.6

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


4 Files Affected:

- (modified) flang/lib/Semantics/check-omp-structure.cpp (+4-1) 
- (modified) flang/lib/Semantics/resolve-directives.cpp (+30) 
- (added) flang/test/Semantics/OpenMP/threadprivate-equivalence.f90 (+19) 
- (modified) flang/test/Semantics/OpenMP/threadprivate02.f90 (+2-1) 


``````````diff
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 431c41f443f7a..44f8d46862ba3 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1364,8 +1364,11 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
     for (const auto &obj : cb->objects()) {
       if (FindEquivalenceSet(*obj)) {
         context_.Say(name.source,
-            "A variable in a %s directive cannot appear in an EQUIVALENCE statement (variable '%s' from common block '/%s/')"_err_en_US,
+            "A variable in a %s directive used in an EQUIVALENCE statement is "
+            "an OpenMP extension (variable '%s' from common block "
+            "'/%s/')"_warn_en_US,
             ContextDirectiveAsFortran(), obj->name(), name.symbol->name());
+        fprintf(stderr, "--> %s\n", name.ToString().c_str());
       }
     }
   }
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index c8ffa22d6bb5f..0b5c776946df5 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1115,6 +1115,7 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
   void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
   void ResolveOmpName(const parser::Name &, Symbol::Flag);
+  void PropagateOmpFlagToEquivalenceSet(const Symbol &, Symbol::Flag);
   Symbol *ResolveName(const parser::Name *);
   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
@@ -3243,6 +3244,30 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
   }
 }
 
+void OmpAttributeVisitor::PropagateOmpFlagToEquivalenceSet(
+    const Symbol &symbol, Symbol::Flag ompFlag) {
+  // Find the equivalence set containing this symbol
+  if (const EquivalenceSet *eqSet = FindEquivalenceSet(symbol)) {
+    // Propagate the flag to all symbols in the equivalence set
+    for (const EquivalenceObject &eqObj : *eqSet) {
+      Symbol &eqSymbol = eqObj.symbol;
+
+      // Skip the symbol itself (already has the flag)
+      if (&eqSymbol == &symbol) {
+        continue;
+      }
+
+      // Set the OpenMP flag on the equivalenced symbol
+      if (Symbol * resolvedSymbol{ResolveOmp(eqSymbol, ompFlag, currScope())}) {
+        // Also add to the context if needed
+        if (ompFlagsRequireMark.test(ompFlag)) {
+          AddToContextObjectWithExplicitDSA(*resolvedSymbol, ompFlag);
+        }
+      }
+    }
+  }
+}
+
 void OmpAttributeVisitor::ResolveOmpCommonBlock(
     const parser::Name &name, Symbol::Flag ompFlag) {
   if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
@@ -3261,6 +3286,11 @@ void OmpAttributeVisitor::ResolveOmpCommonBlock(
           AddToContextObjectWithExplicitDSA(*resolvedObject, ompFlag);
         }
         details.replace_object(*resolvedObject, index);
+
+        // Propagate the flag to symbols in the equivalence set
+        if (ompFlagsRequireMark.test(ompFlag)) {
+          PropagateOmpFlagToEquivalenceSet(*resolvedObject, ompFlag);
+        }
       }
     }
   } else {
diff --git a/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90 b/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90
new file mode 100644
index 0000000000000..8896697c8812a
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90
@@ -0,0 +1,19 @@
+! 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 threadprivate02
+  common /blk1/ a1
+  real :: a1
+  real :: eq_a
+  equivalence(eq_a, a1)
+
+  ! This is an extension to the OpenMP semantics, see https://github.com/llvm/llvm-project/issues/180493
+  !WARNING: A variable in a THREADPRIVATE directive used in an EQUIVALENCE statement is an OpenMP extension (variable 'a1' from common block '/blk1/')
+  !$omp threadprivate(/blk1/)
+
+  !ERROR: A THREADPRIVATE variable cannot be in SHARED clause
+  !$omp parallel shared(eq_a)
+  !$omp end parallel
+end
\ No newline at end of file
diff --git a/flang/test/Semantics/OpenMP/threadprivate02.f90 b/flang/test/Semantics/OpenMP/threadprivate02.f90
index 9dc031a8ce47e..fbbabc4319259 100644
--- a/flang/test/Semantics/OpenMP/threadprivate02.f90
+++ b/flang/test/Semantics/OpenMP/threadprivate02.f90
@@ -28,7 +28,8 @@ program threadprivate02
   !$omp threadprivate(eq_c)
   equivalence(eq_c, eq_d)
 
-  !ERROR: A variable in a THREADPRIVATE directive cannot appear in an EQUIVALENCE statement (variable 'eq_e' from common block '/blk2/')
+  ! This is an extension to the OpenMP semantics, see https://github.com/llvm/llvm-project/issues/180493
+  !WARNING: A variable in a THREADPRIVATE directive used in an EQUIVALENCE statement is an OpenMP extension (variable 'eq_e' from common block '/blk2/')
   !$omp threadprivate(/blk2/)
 
 contains

``````````

</details>


https://github.com/llvm/llvm-project/pull/186696