[flang-commits] [flang] 7a91794 - [Flang][OpenMP] Add semantic checks for OpenMP Private clause.
Praveen G via flang-commits
flang-commits at lists.llvm.org
Mon Nov 30 08:53:36 PST 2020
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
More information about the flang-commits
mailing list