Index: flang/lib/Semantics/check-omp-structure.h =================================================================== --- flang/lib/Semantics/check-omp-structure.h +++ flang/lib/Semantics/check-omp-structure.h @@ -178,6 +178,8 @@ void CheckDependList(const parser::DataRef &); void CheckDependArraySection( const common::Indirection &, const parser::Name &); + void CheckIntentInPointer( + const parser::OmpObjectList &, const llvm::omp::Clause); }; } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_ Index: flang/lib/Semantics/check-omp-structure.cpp =================================================================== --- flang/lib/Semantics/check-omp-structure.cpp +++ flang/lib/Semantics/check-omp-structure.cpp @@ -385,7 +385,6 @@ CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable) CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup) CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch) -CHECK_SIMPLE_CLAUSE(Private, OMPC_private) CHECK_SIMPLE_CLAUSE(Shared, OMPC_shared) CHECK_SIMPLE_CLAUSE(To, OMPC_to) CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) @@ -421,6 +420,11 @@ } } +void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { + CheckAllowed(llvm::omp::Clause::OMPC_private); + CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); +} + // Following clauses have a seperate node in parse-tree.h. CHECK_SIMPLE_PARSER_CLAUSE(OmpAllocateClause, OMPC_allocate) CHECK_SIMPLE_PARSER_CLAUSE(OmpDefaultClause, OMPC_default) @@ -613,6 +617,40 @@ } } +void OmpStructureChecker::CheckIntentInPointer( + const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { + for (const auto &ompObject : objectList.v) { + if (const auto *name{parser::Unwrap(ompObject)}) { + if (const auto *symbol{name->symbol}) { + if (const auto *commonBlockDetails{ + symbol->detailsIf()}) { + for (const auto &object : commonBlockDetails->objects()) { + if (IsPointer(*object) && IsIntentIn(*object)) { + context_.Say(name->source, + "Pointer '%s' in the COMMON block with the INTENT(IN) " + "attribute may not appear in a %s clause"_err_en_US, + object->name(), + parser::ToUpperCaseLetters(getClauseName(clause).str())); + } + } + } else { + if (const auto *hostAssocDetails{ + symbol->detailsIf()}) { + symbol = &hostAssocDetails->symbol(); + } + 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 @@ -362,6 +362,9 @@ void CheckDataCopyingClause( const parser::Name &, const Symbol &, Symbol::Flag); + void GetNamelistSymbols(SymbolVector &, const Scope &); + void CheckObjectInNamelist( + const parser::Name &, const Symbol &, Symbol::Flag); }; template @@ -1023,6 +1026,10 @@ if (dataSharingAttributeFlags.test(ompFlag)) { CheckMultipleAppearances(*name, *symbol, ompFlag); } + if (privateDataSharingAttributeFlags.test(ompFlag)) { + CheckObjectInNamelist(*name, *symbol, ompFlag); + } + if (ompFlag == Symbol::Flag::OmpAllocate) { AddAllocateName(name); } @@ -1174,4 +1181,46 @@ } } +void OmpAttributeVisitor::CheckObjectInNamelist( + const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { + SymbolVector namelistSymbols; + const auto &ultimateSymbol{symbol.GetUltimate()}; + const auto &ultimateScope{ultimateSymbol.owner()}; + // Identify all the namelist objects + GetNamelistSymbols(namelistSymbols, currScope().parent()); + if (ultimateScope.IsModule()) { + GetNamelistSymbols(namelistSymbols, ultimateScope); + } + if (!namelistSymbols.empty()) { + auto it{std::find( + namelistSymbols.begin(), namelistSymbols.end(), ultimateSymbol)}; + if (it != namelistSymbols.end()) { + llvm::StringRef clauseName{"PRIVATE"}; + if (ompFlag == Symbol::Flag::OmpFirstPrivate) + clauseName = "FIRSTPRIVATE"; + else if (ompFlag == Symbol::Flag::OmpLastPrivate) + clauseName = "LASTPRIVATE"; + context_.Say(name.source, + "Variable '%s' in %s clause is used in NAMELIST statement"_err_en_US, + name.ToString(), clauseName.str()); + } + } +} + +void OmpAttributeVisitor::GetNamelistSymbols( + SymbolVector &namelistSymbols, const Scope &scope) { + const auto symbols{scope.GetSymbols()}; + const auto &parentScope{scope.parent()}; + for (const auto &symbol : symbols) { + if (const auto *namelistDetail{symbol->detailsIf()}) { + for (const auto &object : namelistDetail->objects()) { + namelistSymbols.emplace_back(object->GetUltimate()); + } + } + } + if (!parentScope.IsGlobal()) { + GetNamelistSymbols(namelistSymbols, parentScope); + } +} + } // 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' in the COMMON block 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 Index: flang/test/Semantics/omp-private04.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private04.f90 @@ -0,0 +1,28 @@ +! 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. + +module test + integer :: a, b, c + namelist /mylist/ a, b, c +end module + +program omp_private + use test + + a = 5 + b = 10 + + !$omp parallel + !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement + !ERROR: Variable 'b' in PRIVATE clause is used in NAMELIST statement + !$omp parallel private(a, b) + c = a + b + !$omp end parallel + print *, c + !$omp end parallel + + write(*, mylist) + +end program omp_private Index: flang/test/Semantics/omp-private05.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private05.f90 @@ -0,0 +1,27 @@ +! 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_private + integer :: a, b, c + namelist /mylist/ a, b, c + + a = 5 + b = 10 + + call sb() + + contains + subroutine sb() + + !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement + !$omp parallel private(a) + c = a + b + !$omp end parallel + + write(*, mylist) + + end subroutine + +end program omp_private Index: flang/test/Semantics/omp-private06.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private06.f90 @@ -0,0 +1,27 @@ +! 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_private + integer :: a, b, c + + a = 5 + b = 10 + + call sb() + + contains + subroutine sb() + namelist /mylist/ a, b, c + + !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement + !$omp parallel private(a) + c = a + b + !$omp end parallel + + write(*, mylist) + + end subroutine + +end program omp_private Index: flang/test/Semantics/omp-private07.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/omp-private07.f90 @@ -0,0 +1,44 @@ +! 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. + +module test + integer :: a, b, c + namelist /nlist1/ a, b +end module + +program omp_private + use test + + integer :: p(10) ,q(10) + namelist /nlist2/ b, c + + a = 5 + b = 10 + + !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement + !ERROR: Variable 'b' in PRIVATE clause is used in NAMELIST statement + !$omp parallel private(a, b) + c = a + b + !$omp end parallel + + call sb() + + contains + subroutine sb() + namelist /nlist3/ c, p, q + + !ERROR: Variable 'c' in PRIVATE clause is used in NAMELIST statement + !$omp parallel private(c) + p = c * b + q = p * a + !$omp end parallel + + write(*, nlist1) + write(*, nlist2) + write(*, nlist3) + + end subroutine + +end program omp_private