Author: Praveen G Date: 2020-11-30T11:46:36-05:00 New Revision: 7a91794d5b261bc87991d5acce9fa503e9a4f269
URL: https://github.com/llvm/llvm-project/commit/7a91794d5b261bc87991d5acce9fa503e9a4f269 DIFF: https://github.com/llvm/llvm-project/commit/7a91794d5b261bc87991d5acce9fa503e9a4f269.diff LOG: [Flang][OpenMP] Add semantic checks for OpenMP Private clause. Add the semantic checks for the OpenMP 4.5 - 2.15.3.3 Private clause. 1. Pointers with the INTENT(IN) attribute may not appear in a private clause. 2. Variables that appear in namelist statements may not appear in a private clause. A flag 'InNamelist' is added to the Symbol::Flag to identify the symbols in Namelist statemnts. Test cases : omp-private01.f90, omp-private02.f90 Reviewed By: kiranchandramohan Differential Revision: https://reviews.llvm.org/D90210 Added: flang/test/Semantics/omp-private01.f90 flang/test/Semantics/omp-private02.f90 Modified: flang/include/flang/Semantics/symbol.h flang/lib/Semantics/check-omp-structure.cpp flang/lib/Semantics/check-omp-structure.h flang/lib/Semantics/resolve-directives.cpp flang/lib/Semantics/resolve-names.cpp Removed: ################################################################################ diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 29b2696d82e5..246bf2d0b338 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -493,6 +493,7 @@ class Symbol { LocalityLocalInit, // named in LOCAL_INIT locality-spec LocalityShared, // named in SHARED locality-spec InDataStmt, // initialized in a DATA statement + InNamelist, // flag is set if the symbol is in Namelist statement // OpenACC data-sharing attribute AccPrivate, AccFirstPrivate, AccShared, // OpenACC data-mapping attribute diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 636471da78d1..9ed73e65e57c 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -417,6 +417,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) { void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { CheckAllowed(llvm::omp::Clause::OMPC_private); CheckIsVarPartOfAnotherVar(x.v); + CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); } void OmpStructureChecker::CheckIsVarPartOfAnotherVar( @@ -693,4 +694,38 @@ void OmpStructureChecker::CheckDependArraySection( } } +void OmpStructureChecker::CheckIntentInPointer( + const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) { + std::vector<const Symbol *> symbols; + GetSymbolsInObjectList(objectList, symbols); + for (const auto *symbol : symbols) { + if (IsPointer(*symbol) && IsIntentIn(*symbol)) { + context_.Say(GetContext().clauseSource, + "Pointer '%s' with the INTENT(IN) attribute may not appear " + "in a %s clause"_err_en_US, + symbol->name(), + parser::ToUpperCaseLetters(getClauseName(clause).str())); + } + } +} + +void OmpStructureChecker::GetSymbolsInObjectList( + const parser::OmpObjectList &objectList, + std::vector<const Symbol *> &symbols) { + for (const auto &ompObject : objectList.v) { + if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) { + if (const auto *symbol{name->symbol}) { + if (const auto *commonBlockDetails{ + symbol->detailsIf<CommonBlockDetails>()}) { + for (const auto &object : commonBlockDetails->objects()) { + symbols.emplace_back(&object->GetUltimate()); + } + } else { + symbols.emplace_back(&symbol->GetUltimate()); + } + } + } + } +} + } // namespace Fortran::semantics diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 5539ca2566f2..bb1509b4bdfb 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -185,8 +185,11 @@ class OmpStructureChecker void CheckDependList(const parser::DataRef &); void CheckDependArraySection( const common::Indirection<parser::ArrayElement> &, const parser::Name &); - void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList); + void CheckIntentInPointer( + const parser::OmpObjectList &, const llvm::omp::Clause); + void GetSymbolsInObjectList( + const parser::OmpObjectList &, std::vector<const Symbol *> &); }; } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_ diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index f34cb69beca9..56f8f8fae955 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -375,6 +375,8 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> { const parser::Name &, const Symbol &, Symbol::Flag); void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause); + void CheckObjectInNamelist( + const parser::Name &, const Symbol &, Symbol::Flag); }; template <typename T> @@ -1107,6 +1109,10 @@ void OmpAttributeVisitor::ResolveOmpObject( if (dataSharingAttributeFlags.test(ompFlag)) { CheckMultipleAppearances(*name, *symbol, ompFlag); } + if (privateDataSharingAttributeFlags.test(ompFlag)) { + CheckObjectInNamelist(*name, *symbol, ompFlag); + } + if (ompFlag == Symbol::Flag::OmpAllocate) { AddAllocateName(name); } @@ -1258,4 +1264,18 @@ void OmpAttributeVisitor::CheckDataCopyingClause( } } +void OmpAttributeVisitor::CheckObjectInNamelist( + const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { + if (symbol.GetUltimate().test(Symbol::Flag::InNamelist)) { + 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 NAMELIST cannot be in a %s clause"_err_en_US, + name.ToString(), clauseName.str()); + } +} + } // namespace Fortran::semantics diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 95a0b896d12b..a879d009d12d 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4289,6 +4289,7 @@ bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) { } else if (!ConvertToObjectEntity(*symbol)) { SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US); } + symbol->GetUltimate().set(Symbol::Flag::InNamelist); details.add_object(*symbol); } diff --git a/flang/test/Semantics/omp-private01.f90 b/flang/test/Semantics/omp-private01.f90 new file mode 100644 index 000000000000..49c1f0d2c029 --- /dev/null +++ b/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_private(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_private diff --git a/flang/test/Semantics/omp-private02.f90 b/flang/test/Semantics/omp-private02.f90 new file mode 100644 index 000000000000..14978694ff03 --- /dev/null +++ b/flang/test/Semantics/omp-private02.f90 @@ -0,0 +1,46 @@ +! 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/ c, d + + a = 5 + b = 10 + c = 100 + + !ERROR: Variable 'a' in NAMELIST cannot be in a PRIVATE clause + !ERROR: Variable 'c' in NAMELIST cannot be in a PRIVATE clause + !$omp parallel private(a, c) + d = a + b + !$omp end parallel + + call sb() + + contains + subroutine sb() + namelist /nlist3/ p, q + + !ERROR: Variable 'p' in NAMELIST cannot be in a PRIVATE clause + !ERROR: Variable 'd' in NAMELIST cannot be in a PRIVATE clause + !$omp parallel private(p, d) + p = c * b + q = p * d + !$omp end parallel + + write(*, nlist1) + write(*, nlist2) + write(*, nlist3) + + end subroutine + +end program omp_private _______________________________________________ llvm-branch-commits mailing list llvm-branch-commits@lists.llvm.org https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-branch-commits