diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -218,6 +218,8 @@ 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/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1772,7 +1772,6 @@ 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 @@ 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::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 @@ 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 @@ 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/test/Semantics/OpenMP/omp-copying.f90 b/flang/test/Semantics/OpenMP/omp-copying.f90 new file mode 100644 --- /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