Index: flang/lib/Semantics/check-omp-structure.h =================================================================== --- flang/lib/Semantics/check-omp-structure.h +++ flang/lib/Semantics/check-omp-structure.h @@ -162,8 +162,10 @@ void Enter(const parser::OmpReductionClause &); void Enter(const parser::OmpScheduleClause &); -private: + void CheckIntentInPointer( + const parser::Name &, const Symbol &, const llvm::omp::Clause); +private: bool HasInvalidWorksharingNesting( const parser::CharBlock &, const OmpDirectiveSet &); Index: flang/lib/Semantics/check-omp-structure.cpp =================================================================== --- flang/lib/Semantics/check-omp-structure.cpp +++ flang/lib/Semantics/check-omp-structure.cpp @@ -407,8 +407,28 @@ CheckAllowed(llvm::omp::Clause::OMPC_priority); RequiresPositiveParameter(llvm::omp::Clause::OMPC_priority, x.v); } -void OmpStructureChecker::Enter(const parser::OmpClause::Private &) { +void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { CheckAllowed(llvm::omp::Clause::OMPC_private); + // Pointers with the INTENT(IN) attribute may not appear in a private clause + for (const auto &ompObject : x.v.v) { + if (const auto *name{parser::Unwrap(ompObject)}) { + if (const auto *symbol{name->symbol}) { + if (const auto *commonBlockDetails{ + symbol->detailsIf()}) { + for (auto &object : commonBlockDetails->objects()) { + CheckIntentInPointer( + *name, *object, llvm::omp::Clause::OMPC_private); + } + } else { + if (const auto *hostAssocDetails{ + symbol->detailsIf()}) { + symbol = &hostAssocDetails->symbol(); + } + CheckIntentInPointer(*name, *symbol, llvm::omp::Clause::OMPC_private); + } + } + } + } } void OmpStructureChecker::Enter(const parser::OmpClause::Safelen &x) { CheckAllowed(llvm::omp::Clause::OMPC_safelen); @@ -617,6 +637,16 @@ } } +void OmpStructureChecker::CheckIntentInPointer(const parser::Name &name, + const Symbol &symbol, const llvm::omp::Clause clause) { + if (IsPointer(symbol) && IsIntentIn(symbol)) { + context_.Say(name.source, + "Pointer '%s' with the INTENT(IN) attribute may not appear in a " + "%s clause"_err_en_US, + symbol.name(), parser::ToUpperCaseLetters(getClauseName(clause).str())); + } +} + llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) { return llvm::omp::getOpenMPClauseName(clause); } Index: flang/lib/Semantics/resolve-directives.cpp =================================================================== --- flang/lib/Semantics/resolve-directives.cpp +++ flang/lib/Semantics/resolve-directives.cpp @@ -320,6 +320,9 @@ Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); void CheckMultipleAppearances( const parser::Name &, const Symbol &, Symbol::Flag); + SymbolVector GetNamelistSymbols(); + void CheckObjectInNamelist( + const parser::Name &, const Symbol &, Symbol::Flag); }; template @@ -945,6 +948,9 @@ if (dataSharingAttributeFlags.test(ompFlag)) { CheckMultipleAppearances(*name, *symbol, ompFlag); } + if (privateDataSharingAttributeFlags.test(ompFlag)) { + CheckObjectInNamelist(*name, *symbol, ompFlag); + } if (ompFlag == Symbol::Flag::OmpAllocate) { AddAllocateName(name); } @@ -1073,4 +1079,39 @@ } } +void OmpAttributeVisitor::CheckObjectInNamelist( + const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { + auto namelistSymbols = GetNamelistSymbols(); + if (!namelistSymbols.empty()) { + const auto *target{&symbol}; + if (ompFlagsRequireNewSymbol.test(ompFlag)) { + if (const auto *details{symbol.detailsIf()}) { + target = &details->symbol(); + } + } + auto it{std::find(namelistSymbols.begin(), namelistSymbols.end(), *target)}; + if (it != namelistSymbols.end()) { + const auto clauseName{ompFlag == Symbol::Flag::OmpPrivate ? "PRIVATE" + : ompFlag == Symbol::Flag::OmpFirstPrivate ? "FIRSTPRIVATE" + : "LASTPRIVATE"}; + context_.Say(name.source, + "Variable '%s' in %s clause is used in NAMELIST statement"_err_en_US, + name.ToString(), clauseName); + } + } +} + +SymbolVector OmpAttributeVisitor::GetNamelistSymbols() { + SymbolVector namelistSymbols; + const auto symbols{currScope().parent().GetSymbols()}; + for (const auto &symbol : symbols) { + if (const auto *namelistDetail{symbol->detailsIf()}) { + for (auto &object : namelistDetail->objects()) { + namelistSymbols.emplace_back(*object); + } + } + } + return namelistSymbols; +} + } // namespace Fortran::semantics Index: flang/test/Semantics/omp-private01.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private01.f90 @@ -0,0 +1,20 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.3.3 private Clause +! Pointers with the INTENT(IN) attribute may not appear in a private clause. + +subroutine omp_target(p) + integer :: a(10), b(10), c(10) + integer, pointer, intent(in) :: p + + a = 10 + b = 20 + + !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a PRIVATE clause + !$omp parallel private(p) + c = a + b + p + !$omp end parallel + + print *, c + +end subroutine omp_target Index: flang/test/Semantics/omp-private02.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private02.f90 @@ -0,0 +1,23 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.3.3 private Clause +! Pointers with the INTENT(IN) attribute may not appear in a private clause. + +subroutine omp_target(p) + integer :: a(10), b(10), c(10) + integer, pointer, intent(in) :: p + + !ERROR: Dummy argument 'p' may not appear in a COMMON block + common /cmn/ c, p + + a = 10 + b = 20 + + !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a PRIVATE clause + !$omp parallel private(/cmn/) + c = a + b + p + !$omp end parallel + + print *, c + +end subroutine omp_target Index: flang/test/Semantics/omp-private03.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private03.f90 @@ -0,0 +1,20 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.3.3 private Clause +! Variables that appear in namelist statements may not appear in a private clause. + +program omp_target + integer :: a, b, c + namelist /mylist/ a, b, c + + a = 5 + b = 10 + + !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement + !$omp parallel private(a) + c = a+b + !$omp end parallel + + write(*, mylist) + +end program omp_target