[flang-commits] [flang] 9441003 - [flang][OpenMP] Add one semantic check for data-sharing clauses

[via flang-commits]

Author: Peixin-Qiao
Date: 2022-06-15T16:02:27+08:00
New Revision: 9441003b5258c7e206b5a3b7324a0eedee705160

URL: https://github.com/llvm/llvm-project/commit/9441003b5258c7e206b5a3b7324a0eedee705160
DIFF: https://github.com/llvm/llvm-project/commit/9441003b5258c7e206b5a3b7324a0eedee705160.diff

LOG: [flang][OpenMP] Add one semantic check for data-sharing clauses

As OpenMP 5.0, for firstprivate, lastprivate, copyin, and copyprivate
clauses, if the list item is a polymorphic variable with the allocatable
attribute, the behavior is unspecified.

Reviewed By: kiranchandramohan

Differential Revision: https://reviews.llvm.org/D127601

Added: 
    flang/test/Semantics/OpenMP/omp-copying.f90

Modified: 
    flang/lib/Semantics/check-omp-structure.cpp
    flang/lib/Semantics/check-omp-structure.h

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 171198a787dee..58ad55bde405f 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1772,7 +1772,6 @@ CHECK_SIMPLE_CLAUSE(AtomicDefaultMemOrder, OMPC_atomic_default_mem_order)
 CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate)
 CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
-CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
 CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
 CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy)
@@ -2094,6 +2093,8 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
 
   SymbolSourceMap currSymbols;
   GetSymbolsInObjectList(x.v, currSymbols);
+  CheckCopyingPolymorphicAllocatable(
+      currSymbols, llvm::omp::Clause::OMPC_firstprivate);
 
   DirectivesClauseTriple dirClauseTriple;
   // Check firstprivate variables in worksharing constructs
@@ -2356,9 +2357,28 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
   }
 }
 
+void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
+    SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
+  for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
+    const auto *symbol{it->first};
+    const auto source{it->second};
+    if (IsPolymorphicAllocatable(*symbol)) {
+      context_.Say(source,
+          "If a polymorphic variable with allocatable attribute '%s' is in "
+          "%s clause, the behavior is unspecified"_port_en_US,
+          symbol->name(),
+          parser::ToUpperCaseLetters(getClauseName(clause).str()));
+    }
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
+  SymbolSourceMap currSymbols;
+  GetSymbolsInObjectList(x.v, currSymbols);
+  CheckCopyingPolymorphicAllocatable(
+      currSymbols, llvm::omp::Clause::OMPC_copyprivate);
 }
 
 void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
@@ -2368,6 +2388,8 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
   SymbolSourceMap currSymbols;
   GetSymbolsInObjectList(x.v, currSymbols);
   CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x));
+  CheckCopyingPolymorphicAllocatable(
+      currSymbols, llvm::omp::Clause::OMPC_lastprivate);
 
   // Check lastprivate variables in worksharing constructs
   dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
@@ -2381,6 +2403,15 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
       currSymbols, dirClauseTriple, GetClauseKindForParserClass(x));
 }
 
+void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
+  CheckAllowed(llvm::omp::Clause::OMPC_copyin);
+
+  SymbolSourceMap currSymbols;
+  GetSymbolsInObjectList(x.v, currSymbols);
+  CheckCopyingPolymorphicAllocatable(
+      currSymbols, llvm::omp::Clause::OMPC_copyin);
+}
+
 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
   return llvm::omp::getOpenMPClauseName(clause);
 }

diff  --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index ccf3b06cf4d72..e959fb751cc99 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -218,6 +218,8 @@ class OmpStructureChecker
       const parser::OmpObjectList &, const llvm::omp::Clause);
   void GetSymbolsInObjectList(const parser::OmpObjectList &, SymbolSourceMap &);
   void CheckDefinableObjects(SymbolSourceMap &, const llvm::omp::Clause);
+  void CheckCopyingPolymorphicAllocatable(
+      SymbolSourceMap &, const llvm::omp::Clause);
   void CheckPrivateSymbolsInOuterCxt(
       SymbolSourceMap &, DirectivesClauseTriple &, const llvm::omp::Clause);
   const parser::Name GetLoopIndex(const parser::DoConstruct *x);

diff  --git a/flang/test/Semantics/OpenMP/omp-copying.f90 b/flang/test/Semantics/OpenMP/omp-copying.f90
new file mode 100644
index 0000000000000..0095a0989c60e
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/omp-copying.f90
@@ -0,0 +1,52 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp
+! OpenMP Version 5.0
+! 2.19.4.4 firstprivate Clause
+! 2.19.4.5 lastprivate Clause
+! 2.19.6.1 copyin Clause
+! 2.19.6.2 copyprivate Clause
+! If the list item is a polymorphic variable with the allocatable attribute,
+! the behavior is unspecified.
+
+subroutine firstprivate()
+  class(*), allocatable, save :: x
+
+  !WARNING: If a polymorphic variable with allocatable attribute 'x' is in FIRSTPRIVATE clause, the behavior is unspecified
+  !$omp parallel firstprivate(x)
+    call sub()
+  !$omp end parallel
+
+end
+
+subroutine lastprivate()
+  class(*), allocatable, save :: x
+
+  !WARNING: If a polymorphic variable with allocatable attribute 'x' is in LASTPRIVATE clause, the behavior is unspecified
+  !$omp do lastprivate(x)
+  do i = 1, 10
+    call sub()
+  enddo
+  !$omp end do
+
+end
+
+subroutine copyin()
+  class(*), allocatable, save :: x
+  !$omp threadprivate(x)
+
+  !WARNING: If a polymorphic variable with allocatable attribute 'x' is in COPYIN clause, the behavior is unspecified
+  !$omp parallel copyin(x)
+    call sub()
+  !$omp end parallel
+
+end
+
+subroutine copyprivate()
+  class(*), allocatable, save :: x
+  !$omp threadprivate(x)
+
+  !WARNING: If a polymorphic variable with allocatable attribute 'x' is in COPYPRIVATE clause, the behavior is unspecified
+  !$omp single copyprivate(x)
+    call sub()
+  !$omp end single
+
+end