[flang-commits] [flang] [Flang][OpenMP] Permit THREADPRIVATE variables in EQUIVALENCE statements (PR #186696)
Michael Klemm via flang-commits
flang-commits at lists.llvm.org
Sun Mar 15 13:27:34 PDT 2026
https://github.com/mjklemm updated https://github.com/llvm/llvm-project/pull/186696
>From 3cc8fc5d8f49e5b916d4b621a1e40b6518203012 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Sun, 15 Mar 2026 19:49:04 +0100
Subject: [PATCH 1/4] [Flang][OpenMP} Permit THREADPRIVATE variables in
EQUIVALENCE statements
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
---
flang/lib/Semantics/check-omp-structure.cpp | 5 +++-
flang/lib/Semantics/resolve-directives.cpp | 30 +++++++++++++++++++
.../OpenMP/threadprivate-equivalence.f90 | 19 ++++++++++++
.../test/Semantics/OpenMP/threadprivate02.f90 | 3 +-
4 files changed, 55 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/threadprivate-equivalence.f90
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
>From 16953fc64ad996bdf49271edc38162a90660ce5b Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Sun, 15 Mar 2026 20:49:33 +0100
Subject: [PATCH 2/4] Implement suggestions of code review
---
flang/lib/Semantics/check-omp-structure.cpp | 5 +----
flang/lib/Semantics/resolve-directives.cpp | 4 ++--
2 files changed, 3 insertions(+), 6 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 44f8d46862ba3..515e08c2f9915 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1364,11 +1364,8 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
for (const auto &obj : cb->objects()) {
if (FindEquivalenceSet(*obj)) {
context_.Say(name.source,
- "A variable in a %s directive used in an EQUIVALENCE statement is "
- "an OpenMP extension (variable '%s' from common block "
- "'/%s/')"_warn_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 0b5c776946df5..5c054d8fe87e9 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3247,10 +3247,10 @@ 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)) {
+ 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;
+ Symbol &eqSymbol{eqObj.symbol};
// Skip the symbol itself (already has the flag)
if (&eqSymbol == &symbol) {
>From f7a88253b9a08850af64f8a819b61f1ba919bae3 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Sun, 15 Mar 2026 21:09:52 +0100
Subject: [PATCH 3/4] Separate message for THREADPRIVATE and DELCARE TARGET
---
flang/lib/Semantics/check-omp-structure.cpp | 13 ++++++++++---
flang/lib/Semantics/resolve-directives.cpp | 2 +-
2 files changed, 11 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 515e08c2f9915..1a953e789b6ef 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1361,11 +1361,18 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
}
if (auto *cb{name.symbol->detailsIf<CommonBlockDetails>()}) {
+ llvm::omp::Directive directive{GetContext().directive};
for (const auto &obj : cb->objects()) {
if (FindEquivalenceSet(*obj)) {
- context_.Say(name.source,
- "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());
+ if (directive == llvm::omp::Directive::OMPD_threadprivate) {
+ context_.Say(name.source,
+ "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());
+ } else {
+ 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,
+ ContextDirectiveAsFortran(), obj->name(), name.symbol->name());
+ }
}
}
}
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 5c054d8fe87e9..c18b00b4aec93 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3288,7 +3288,7 @@ void OmpAttributeVisitor::ResolveOmpCommonBlock(
details.replace_object(*resolvedObject, index);
// Propagate the flag to symbols in the equivalence set
- if (ompFlagsRequireMark.test(ompFlag)) {
+ if (ompFlag == Symbol::Flag::OmpThreadprivate) {
PropagateOmpFlagToEquivalenceSet(*resolvedObject, ompFlag);
}
}
>From 3587d9a39a6554c870393e0130f712d3bef1f60b Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Sun, 15 Mar 2026 21:27:01 +0100
Subject: [PATCH 4/4] Make the warning have a -Wno flag
---
flang/include/flang/Support/Fortran-features.h | 3 ++-
flang/lib/Semantics/check-omp-structure.cpp | 3 ++-
flang/lib/Support/Fortran-features.cpp | 1 +
flang/test/Semantics/OpenMP/threadprivate-equivalence.f90 | 2 +-
flang/test/Semantics/OpenMP/threadprivate02.f90 | 2 +-
5 files changed, 7 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index cbcb3592f04c3..87326ffa7a6f0 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -57,7 +57,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
ForwardRefExplicitTypeDummy, InaccessibleDeferredOverride,
CudaWarpMatchFunction, DoConcurrentOffload, TransferBOZ, Coarray,
PointerPassObject, MultipleIdenticalDATA,
- DefaultStructConstructorNullPointer, AssumedRankIoItem)
+ DefaultStructConstructorNullPointer, AssumedRankIoItem,
+ OpenMPThreadprivateEquivalence)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 1a953e789b6ef..d4c0f79d87afb 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1365,7 +1365,8 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
for (const auto &obj : cb->objects()) {
if (FindEquivalenceSet(*obj)) {
if (directive == llvm::omp::Directive::OMPD_threadprivate) {
- context_.Say(name.source,
+ context_.Warn(common::LanguageFeature::OpenMPThreadprivateEquivalence,
+ name.source,
"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());
} else {
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index 83d1affba5ed2..861af18de75b7 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -153,6 +153,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnLanguage_.set(LanguageFeature::NullActualForAllocatable);
warnUsage_.set(UsageWarning::BadValueInDeadCode);
warnUsage_.set(UsageWarning::MisplacedIgnoreTKR);
+ warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence);
}
std::optional<LanguageControlFlag> LanguageFeatureControl::FindWarning(
diff --git a/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90 b/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90
index 8896697c8812a..a4a4aaea8e383 100644
--- a/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90
+++ b/flang/test/Semantics/OpenMP/threadprivate-equivalence.f90
@@ -10,7 +10,7 @@ program threadprivate02
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/')
+ !WARNING: A variable in a THREADPRIVATE directive used in an EQUIVALENCE statement is an OpenMP extension (variable 'a1' from common block '/blk1/') [-Wopen-mp-threadprivate-equivalence]
!$omp threadprivate(/blk1/)
!ERROR: A THREADPRIVATE variable cannot be in SHARED clause
diff --git a/flang/test/Semantics/OpenMP/threadprivate02.f90 b/flang/test/Semantics/OpenMP/threadprivate02.f90
index fbbabc4319259..591711429c502 100644
--- a/flang/test/Semantics/OpenMP/threadprivate02.f90
+++ b/flang/test/Semantics/OpenMP/threadprivate02.f90
@@ -29,7 +29,7 @@ program threadprivate02
equivalence(eq_c, eq_d)
! 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/')
+ !WARNING: A variable in a THREADPRIVATE directive used in an EQUIVALENCE statement is an OpenMP extension (variable 'eq_e' from common block '/blk2/') [-Wopen-mp-threadprivate-equivalence]
!$omp threadprivate(/blk2/)
contains
More information about the flang-commits
mailing list