[flang-commits] [flang] [flang][OpenMP] Fix copyprivate semantic checks (PR #95799)
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 17 07:52:20 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Leandro Lupori (luporl)
<details>
<summary>Changes</summary>
There are some cases in which variables used in OpenMP constructs
are predetermined as private. The semantic checks for copyprivate
were not handling those cases.
Fixes #<!-- -->87214 and #<!-- -->86907
---
Full diff: https://github.com/llvm/llvm-project/pull/95799.diff
3 Files Affected:
- (modified) flang/include/flang/Semantics/tools.h (+1)
- (modified) flang/lib/Semantics/resolve-directives.cpp (+38-5)
- (added) flang/test/Semantics/OpenMP/copyprivate04.f90 (+84)
``````````diff
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 0b5308d9242de..5afbacbbbeea7 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -87,6 +87,7 @@ bool IsIntrinsicConcat(
bool IsGenericDefinedOp(const Symbol &);
bool IsDefinedOperator(SourceName);
std::string MakeOpName(SourceName);
+bool IsCommonBlockContaining(const Symbol &, const Symbol &);
// Returns true if maybeAncestor exists and is a proper ancestor of a
// descendent scope (or symbol owner). Will be false, unlike Scope::Contains(),
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index dbc531372c3f4..e13a3c076abed 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -19,6 +19,7 @@
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Semantics/expression.h"
+#include "flang/Semantics/tools.h"
#include <list>
#include <map>
#include <sstream>
@@ -2540,6 +2541,32 @@ void ResolveOmpTopLevelParts(
});
}
+static bool IsSymbolInCommonBlock(const Symbol &symbol) {
+ // If there are many symbols in common blocks, going through them all can be
+ // slow. A possible optimization is to add an OmpInCommonBlock flag to
+ // Symbol, to make it possible to quickly test if a given symbol is in a
+ // common block.
+ for (const auto &cb : symbol.owner().commonBlocks()) {
+ if (IsCommonBlockContaining(cb.second.get(), symbol)) {
+ return true;
+ }
+ }
+ return false;
+}
+
+static bool IsSymbolPredeterminedAsPrivate(const Symbol &symbol) {
+ switch (symbol.owner().kind()) {
+ case Scope::Kind::MainProgram:
+ case Scope::Kind::Subprogram:
+ case Scope::Kind::BlockConstruct:
+ return !symbol.attrs().test(Attr::SAVE) &&
+ !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) &&
+ !IsSymbolInCommonBlock(symbol);
+ default:
+ return false;
+ }
+}
+
void OmpAttributeVisitor::CheckDataCopyingClause(
const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
const auto *checkSymbol{&symbol};
@@ -2566,13 +2593,19 @@ void OmpAttributeVisitor::CheckDataCopyingClause(
"COPYPRIVATE variable '%s' may not appear on a PRIVATE or "
"FIRSTPRIVATE clause on a SINGLE construct"_err_en_US,
symbol.name());
- } else {
+ } else if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate) &&
+ !(HasSymbolInEnclosingScope(symbol, currScope()) &&
+ (symbol.test(Symbol::Flag::OmpPrivate) ||
+ symbol.test(Symbol::Flag::OmpFirstPrivate)))) {
// List of items/objects that can appear in a 'copyprivate' clause must be
// either 'private' or 'threadprivate' in enclosing context.
- if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate) &&
- !(HasSymbolInEnclosingScope(symbol, currScope()) &&
- (symbol.test(Symbol::Flag::OmpPrivate) ||
- symbol.test(Symbol::Flag::OmpFirstPrivate)))) {
+ // If the symbol used in 'copyprivate' has not gone through constructs
+ // that may privatize the original symbol, then it may be predetermined
+ // as private in some cases.
+ // (OMP 5.2 5.1.1 - Variables Referenced in a Construct)
+ if (!HasSymbolInEnclosingScope(symbol, currScope()) ||
+ symbol != symbol.GetUltimate() ||
+ !IsSymbolPredeterminedAsPrivate(symbol)) {
context_.Say(name.source,
"COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in "
"outer context"_err_en_US,
diff --git a/flang/test/Semantics/OpenMP/copyprivate04.f90 b/flang/test/Semantics/OpenMP/copyprivate04.f90
new file mode 100644
index 0000000000000..5db3caf9b6964
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/copyprivate04.f90
@@ -0,0 +1,84 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
+! OpenMP Version 5.2
+! 5.1.1 - Variables Referenced in a Construct
+! Copyprivate must accept variables that are predetermined as private.
+
+module m1
+ integer :: m
+end module
+
+program omp_copyprivate
+ use m1
+ implicit none
+ integer :: i
+ integer, save :: j
+ integer :: k
+ common /c/ k
+ real, parameter :: pi = 3.14
+ integer :: a1(10)
+
+ ! Local variables are private.
+ !$omp single
+ i = 123
+ !$omp end single copyprivate(i)
+ !$omp single
+ !$omp end single copyprivate(a1)
+
+ ! Variables with the SAVE attribute are not private.
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'j' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(j)
+
+ ! Common block variables are not private.
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'k' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(/c/)
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'k' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(k)
+
+ ! Module variables are not private.
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'm' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(m)
+
+ ! Parallel can make a variable shared.
+ !$omp parallel
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'i' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(i)
+ call sub(j, a1)
+ !$omp end parallel
+
+ ! Named constants are shared.
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'pi' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(pi)
+
+contains
+ subroutine sub(s1, a)
+ integer :: s1
+ integer :: a(:)
+
+ ! Dummy argument.
+ !$omp single
+ !$omp end single copyprivate(s1)
+
+ ! Assumed shape arrays are shared.
+ !$omp single
+ !ERROR: COPYPRIVATE variable 'a' is not PRIVATE or THREADPRIVATE in outer context
+ !$omp end single copyprivate(a)
+ end subroutine
+
+ integer function fun(f1)
+ integer :: f1
+
+ ! Dummy argument.
+ !$omp single
+ !$omp end single copyprivate(f1)
+
+ ! Function result is private.
+ !$omp single
+ !$omp end single copyprivate(fun)
+ end function
+end program
``````````
</details>
https://github.com/llvm/llvm-project/pull/95799
More information about the flang-commits
mailing list