[flang-commits] [flang] [flang][OpenMP] catch namelist access through equivalence (PR #130804)
Tom Eccles via flang-commits
flang-commits at lists.llvm.org
Tue Mar 11 10:31:14 PDT 2025
https://github.com/tblah created https://github.com/llvm/llvm-project/pull/130804
The standard prohibits privatising namelist variables. We also decided in #110671 to prohibit reductions of namelist variables.
This commit prevents this rule from being circumvented through the use of equivalence statements.
Fixes #122824
>From 7f6446922ec99a2ce3ecf2e685d10c8bca307988 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Tue, 11 Mar 2025 17:26:19 +0000
Subject: [PATCH] [flang][OpenMP] catch namelist access through equivalence
The standard prohibits privatising namelist variables. We also decided
in #110671 to prohibit reductions of namelist variables.
This commit prevents this rule from being circumvented through the use
of equivalence statements.
Fixes #122824
---
flang/lib/Semantics/resolve-directives.cpp | 23 +++++++++++--
.../Semantics/OpenMP/equivalence-namelist.f90 | 32 +++++++++++++++++++
2 files changed, 52 insertions(+), 3 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/equivalence-namelist.f90
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 977c2fef34091..ce96eb9b7782e 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2404,6 +2404,24 @@ void OmpAttributeVisitor::ResolveOmpObjectList(
}
}
+/// True if either symbol is in a namelist or some other symbol in the same
+/// equivalence set as symbol is in a namelist.
+static bool SymbolOrEquivalentIsInNamelist(const Symbol &symbol) {
+ auto isInNamelist{[](const Symbol &sym) {
+ const Symbol &ultimate{sym.GetUltimate()};
+ return ultimate.test(Symbol::Flag::InNamelist);
+ }};
+
+ const EquivalenceSet *eqv{FindEquivalenceSet(symbol)};
+ if (!eqv) {
+ return isInNamelist(symbol);
+ }
+
+ return llvm::any_of(*eqv, [isInNamelist](const EquivalenceObject &obj) {
+ return isInNamelist(obj.symbol);
+ });
+}
+
void OmpAttributeVisitor::ResolveOmpObject(
const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
common::visit(
@@ -2468,7 +2486,6 @@ void OmpAttributeVisitor::ResolveOmpObject(
.str()));
}
if (ompFlag == Symbol::Flag::OmpReduction) {
- const Symbol &ultimateSymbol{symbol->GetUltimate()};
// Using variables inside of a namelist in OpenMP reductions
// is allowed by the standard, but is not allowed for
// privatisation. This looks like an oversight. If the
@@ -2476,7 +2493,7 @@ void OmpAttributeVisitor::ResolveOmpObject(
// mapping for the reduction variable: resulting in incorrect
// results. Disabling this hoisting could make some real
// production code go slower. See discussion in #109303
- if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
+ if (SymbolOrEquivalentIsInNamelist(*symbol)) {
context_.Say(name->source,
"Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US,
name->ToString());
@@ -2838,7 +2855,7 @@ void OmpAttributeVisitor::CheckObjectIsPrivatizable(
clauseName = "LASTPRIVATE";
}
- if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
+ if (SymbolOrEquivalentIsInNamelist(symbol)) {
context_.Say(name.source,
"Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,
name.ToString(), clauseName.str());
diff --git a/flang/test/Semantics/OpenMP/equivalence-namelist.f90 b/flang/test/Semantics/OpenMP/equivalence-namelist.f90
new file mode 100644
index 0000000000000..dc0a1712ed8f5
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/equivalence-namelist.f90
@@ -0,0 +1,32 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp
+
+! The openmp standard only dissallows namelist for privatization, but flang
+! also does not allow it for reduction as this would be difficult to support.
+!
+! Variables in equivalence with variables in the namelist pose the same
+! implementation problems.
+
+subroutine test01()
+ integer::va
+ equivalence (va,vva)
+ namelist /na1/vva
+ va=1
+
+!ERROR: Variable 'va' in NAMELIST cannot be in a REDUCTION clause
+!$omp parallel reduction(+:va)
+ write(*,na1)
+!$omp end parallel
+end subroutine test01
+
+
+subroutine test02()
+ integer::va
+ equivalence (va,vva)
+ namelist /na1/vva
+ va=1
+
+!ERROR: Variable 'va' in NAMELIST cannot be in a PRIVATE clause
+!$omp parallel private(va)
+ write(*,na1)
+!$omp end parallel
+end subroutine test02
More information about the flang-commits
mailing list