Add Semantic check for Flang OpenMP 4.5 - 2.15.3.6 Reduction clause
Implementation of Reduction clause restriction checks.
Files:
flang/lib/Semantics/check-directive-structure.h
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-omp-structure.h
flang/lib/Semantics/resolve-directives.cpp
Testcases:
flang/test/Semantics/omp-reduction01.f90
flang/test/Semantics/omp-reduction02.f90
flang/test/Semantics/omp-reduction03.f90
flang/test/Semantics/omp-reduction04.f90
flang/test/Semantics/omp-reduction05.f90
flang/test/Semantics/omp-reduction06.f90
flang/test/Semantics/omp-reduction07.f90
flang/test/Semantics/omp-reduction08.f90
flang/test/Semantics/omp-reduction09.f90
flang/test/Semantics/omp-reduction10.f90
flang/test/Semantics/omp-symbol08.f90
Reviewed by: Kiran Chandramohan @kiranchandramohan and Valentin Clement @clementval.
Differential Revision: https://reviews.llvm.org/D90697
GitOrigin-RevId: 96716e6749c31493f5a3b57685d4686ba9cdd8fe
diff --git a/lib/Semantics/check-directive-structure.h b/lib/Semantics/check-directive-structure.h
index 5d0750e..c682723 100644
--- a/lib/Semantics/check-directive-structure.h
+++ b/lib/Semantics/check-directive-structure.h
@@ -212,6 +212,15 @@
return it;
}
+ DirectiveContext *GetEnclosingDirContext() {
+ CHECK(!dirContext_.empty());
+ auto it{dirContext_.rbegin()};
+ if (++it != dirContext_.rend()) {
+ return &(*it);
+ }
+ return nullptr;
+ }
+
void PushContext(const parser::CharBlock &source, D dir) {
dirContext_.emplace_back(source, dir);
}
diff --git a/lib/Semantics/check-omp-structure.cpp b/lib/Semantics/check-omp-structure.cpp
index d41e37f..e8b632f 100644
--- a/lib/Semantics/check-omp-structure.cpp
+++ b/lib/Semantics/check-omp-structure.cpp
@@ -390,6 +390,16 @@
}
}
+// TODO: Verify the popping of dirContext requirement after nowait
+// implementation, as there is an implicit barrier at the end of the worksharing
+// constructs unless a nowait clause is specified. Only OMPD_end_sections is
+// popped becuase it is pushed while entering the EndSectionsDirective.
+void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
+ if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
+ dirContext_.pop_back();
+ }
+}
+
void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
@@ -512,6 +522,18 @@
}
}
+// TODO: Verify the popping of dirContext requirement after nowait
+// implementation, as there is an implicit barrier at the end of the worksharing
+// constructs unless a nowait clause is specified. Only OMPD_end_single and
+// end_workshareare popped as they are pushed while entering the
+// EndBlockDirective.
+void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
+ if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
+ (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
+ dirContext_.pop_back();
+ }
+}
+
void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
std::visit(
common::visitors{
@@ -677,7 +699,6 @@
CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait)
CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
-CHECK_SIMPLE_CLAUSE(Reduction, OMPC_reduction)
CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
@@ -710,6 +731,171 @@
// Restrictions specific to each clause are implemented apart from the
// generalized restrictions.
+void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
+ CheckAllowed(llvm::omp::Clause::OMPC_reduction);
+ if (CheckReductionOperators(x)) {
+ CheckReductionTypeList(x);
+ }
+}
+bool OmpStructureChecker::CheckReductionOperators(
+ const parser::OmpClause::Reduction &x) {
+
+ const auto &definedOp{std::get<0>(x.v.t)};
+ bool ok = false;
+ std::visit(
+ common::visitors{
+ [&](const parser::DefinedOperator &dOpr) {
+ const auto &intrinsicOp{
+ std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
+ ok = CheckIntrinsicOperator(intrinsicOp);
+ },
+ [&](const parser::ProcedureDesignator &procD) {
+ const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
+ if (name) {
+ if (name->source == "max" || name->source == "min" ||
+ name->source == "iand" || name->source == "ior" ||
+ name->source == "ieor") {
+ ok = true;
+ } else {
+ context_.Say(GetContext().clauseSource,
+ "Invalid reduction identifier in REDUCTION clause."_err_en_US,
+ ContextDirectiveAsFortran());
+ }
+ }
+ },
+ },
+ definedOp.u);
+
+ return ok;
+}
+bool OmpStructureChecker::CheckIntrinsicOperator(
+ const parser::DefinedOperator::IntrinsicOperator &op) {
+
+ switch (op) {
+ case parser::DefinedOperator::IntrinsicOperator::Add:
+ case parser::DefinedOperator::IntrinsicOperator::Subtract:
+ case parser::DefinedOperator::IntrinsicOperator::Multiply:
+ case parser::DefinedOperator::IntrinsicOperator::AND:
+ case parser::DefinedOperator::IntrinsicOperator::OR:
+ case parser::DefinedOperator::IntrinsicOperator::EQV:
+ case parser::DefinedOperator::IntrinsicOperator::NEQV:
+ return true;
+ default:
+ context_.Say(GetContext().clauseSource,
+ "Invalid reduction operator in REDUCTION clause."_err_en_US,
+ ContextDirectiveAsFortran());
+ }
+ return false;
+}
+
+void OmpStructureChecker::CheckReductionTypeList(
+ const parser::OmpClause::Reduction &x) {
+ const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
+ CheckIntentInPointerAndDefinable(
+ ompObjectList, llvm::omp::Clause::OMPC_reduction);
+ CheckReductionArraySection(ompObjectList);
+ CheckMultipleAppearanceAcrossContext(ompObjectList);
+}
+
+void OmpStructureChecker::CheckIntentInPointerAndDefinable(
+ const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
+ for (const auto &ompObject : objectList.v) {
+ if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
+ if (const auto *symbol{name->symbol}) {
+ if (IsPointer(symbol->GetUltimate()) &&
+ IsIntentIn(symbol->GetUltimate())) {
+ 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()));
+ }
+ if (auto msg{
+ WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
+ context_.Say(GetContext().clauseSource,
+ "Variable '%s' on the %s clause is not definable"_err_en_US,
+ symbol->name(),
+ parser::ToUpperCaseLetters(getClauseName(clause).str()));
+ }
+ }
+ }
+ }
+}
+
+void OmpStructureChecker::CheckReductionArraySection(
+ const parser::OmpObjectList &ompObjectList) {
+ for (const auto &ompObject : ompObjectList.v) {
+ if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
+ if (const auto *arrayElement{
+ parser::Unwrap<parser::ArrayElement>(ompObject)}) {
+ if (arrayElement) {
+ CheckArraySection(*arrayElement, GetLastName(*dataRef),
+ llvm::omp::Clause::OMPC_reduction);
+ }
+ }
+ }
+ }
+}
+
+void OmpStructureChecker::CheckMultipleAppearanceAcrossContext(
+ const parser::OmpObjectList &redObjectList) {
+ const parser::OmpObjectList *objList{nullptr};
+ // TODO: Verify the assumption here that the immediately enclosing region is
+ // the parallel region to which the worksharing construct having reduction
+ // binds to.
+ if (auto *enclosingContext{GetEnclosingDirContext()}) {
+ for (auto it : enclosingContext->clauseInfo) {
+ llvmOmpClause type = it.first;
+ const auto *clause = it.second;
+ if (type == llvm::omp::Clause::OMPC_private) {
+ const auto &pClause{std::get<parser::OmpClause::Private>(clause->u)};
+ objList = &pClause.v;
+ } else if (type == llvm::omp::Clause::OMPC_firstprivate) {
+ const auto &fpClause{
+ std::get<parser::OmpClause::Firstprivate>(clause->u)};
+ objList = &fpClause.v;
+ } else if (type == llvm::omp::Clause::OMPC_lastprivate) {
+ const auto &lpClause{
+ std::get<parser::OmpClause::Lastprivate>(clause->u)};
+ objList = &lpClause.v;
+ } else if (type == llvm::omp::Clause::OMPC_reduction) {
+ const auto &rClause{std::get<parser::OmpClause::Reduction>(clause->u)};
+ const auto &olist{std::get<1>(rClause.v.t)};
+ objList = &olist;
+ }
+ if (objList) {
+ for (const auto &ompObject : objList->v) {
+ if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
+ if (const auto *symbol{name->symbol}) {
+ for (const auto &redOmpObject : redObjectList.v) {
+ if (const auto *rname{
+ parser::Unwrap<parser::Name>(redOmpObject)}) {
+ if (const auto *rsymbol{rname->symbol}) {
+ if (rsymbol->name() == symbol->name()) {
+ context_.Say(GetContext().clauseSource,
+ "%s variable '%s' is %s in outer context must"
+ " be shared in the parallel regions to which any"
+ " of the worksharing regions arising from the "
+ "worksharing"
+ " construct bind."_err_en_US,
+ parser::ToUpperCaseLetters(
+ getClauseName(llvm::omp::Clause::OMPC_reduction)
+ .str()),
+ symbol->name(),
+ parser::ToUpperCaseLetters(
+ getClauseName(type).str()));
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
CheckAllowed(llvm::omp::Clause::OMPC_ordered);
// the parameter of ordered clause is optional
@@ -738,22 +924,13 @@
void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
const parser::OmpObjectList &objList) {
for (const auto &ompObject : objList.v) {
- std::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (std::get_if<parser::DataRef>(&designator.u)) {
- if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
- (parser::Unwrap<parser::ArrayElement>(ompObject))) {
- context_.Say(GetContext().clauseSource,
- "A variable that is part of another variable (as an "
- "array or structure element)"
- " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
- }
- }
- },
- [&](const parser::Name &name) {},
- },
- ompObject.u);
+ if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
+ (parser::Unwrap<parser::ArrayElement>(ompObject))) {
+ context_.Say(GetContext().clauseSource,
+ "A variable that is part of another variable (as an "
+ "array or structure element)"
+ " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
+ }
}
}
void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
@@ -1016,7 +1193,8 @@
if (const auto *arr{
std::get_if<common::Indirection<parser::ArrayElement>>(
&dataRef->u)}) {
- CheckDependArraySection(*arr, GetLastName(*dataRef));
+ CheckArraySection(arr->value(), GetLastName(*dataRef),
+ llvm::omp::Clause::OMPC_depend);
}
}
}
@@ -1080,27 +1258,47 @@
d.u);
}
-void OmpStructureChecker::CheckDependArraySection(
- const common::Indirection<parser::ArrayElement> &arr,
- const parser::Name &name) {
- for (const auto &subscript : arr.value().subscripts) {
- if (const auto *triplet{
- std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
- if (std::get<2>(triplet->t)) {
- context_.Say(GetContext().clauseSource,
- "Stride should not be specified for array section in DEPEND "
- "clause"_err_en_US);
- }
- const auto &lower{std::get<0>(triplet->t)};
- const auto &upper{std::get<1>(triplet->t)};
- if (lower && upper) {
- const auto lval{GetIntValue(lower)};
- const auto uval{GetIntValue(upper)};
- if (lval && uval && *uval < *lval) {
- context_.Say(GetContext().clauseSource,
- "'%s' in DEPEND clause is a zero size array section"_err_en_US,
- name.ToString());
- break;
+// Called from both Reduction and Depend clause.
+void OmpStructureChecker::CheckArraySection(
+ const parser::ArrayElement &arrayElement, const parser::Name &name,
+ const llvm::omp::Clause clause) {
+ if (!arrayElement.subscripts.empty()) {
+ for (const auto &subscript : arrayElement.subscripts) {
+ if (const auto *triplet{
+ std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
+ if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
+ const auto &lower{std::get<0>(triplet->t)};
+ const auto &upper{std::get<1>(triplet->t)};
+ if (lower && upper) {
+ const auto lval{GetIntValue(lower)};
+ const auto uval{GetIntValue(upper)};
+ if (lval && uval && *uval < *lval) {
+ context_.Say(GetContext().clauseSource,
+ "'%s' in %s clause"
+ " is a zero size array section"_err_en_US,
+ name.ToString(),
+ parser::ToUpperCaseLetters(getClauseName(clause).str()));
+ break;
+ } else if (std::get<2>(triplet->t)) {
+ const auto &strideExpr{std::get<2>(triplet->t)};
+ if (strideExpr) {
+ if (clause == llvm::omp::Clause::OMPC_depend) {
+ context_.Say(GetContext().clauseSource,
+ "Stride should not be specified for array section in "
+ "DEPEND "
+ "clause"_err_en_US);
+ }
+ const auto stride{GetIntValue(strideExpr)};
+ if ((stride && stride != 1)) {
+ context_.Say(GetContext().clauseSource,
+ "A list item that appears in a REDUCTION clause"
+ " should have a contiguous storage array section."_err_en_US,
+ ContextDirectiveAsFortran());
+ break;
+ }
+ }
+ }
+ }
}
}
}
@@ -1220,8 +1418,8 @@
}
}
-void OmpStructureChecker::CheckWorkshareBlockStmts(const parser::Block &block,
- parser::CharBlock source) {
+void OmpStructureChecker::CheckWorkshareBlockStmts(
+ const parser::Block &block, parser::CharBlock source) {
OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
for (auto it{block.begin()}; it != block.end(); ++it) {
diff --git a/lib/Semantics/check-omp-structure.h b/lib/Semantics/check-omp-structure.h
index 9415311..cd560dd 100644
--- a/lib/Semantics/check-omp-structure.h
+++ b/lib/Semantics/check-omp-structure.h
@@ -109,10 +109,12 @@
void Enter(const parser::OpenMPBlockConstruct &);
void Leave(const parser::OpenMPBlockConstruct &);
void Enter(const parser::OmpEndBlockDirective &);
+ void Leave(const parser::OmpEndBlockDirective &);
void Enter(const parser::OpenMPSectionsConstruct &);
void Leave(const parser::OpenMPSectionsConstruct &);
void Enter(const parser::OmpEndSectionsDirective &);
+ void Leave(const parser::OmpEndSectionsDirective &);
void Enter(const parser::OpenMPDeclareSimdConstruct &);
void Leave(const parser::OpenMPDeclareSimdConstruct &);
@@ -184,6 +186,17 @@
void CheckCycleConstraints(const parser::OpenMPLoopConstruct &x);
std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x);
void CheckIfDoOrderedClause(const parser::OmpBlockDirective &blkDirectiv);
+ bool CheckReductionOperators(const parser::OmpClause::Reduction &);
+ bool CheckIntrinsicOperator(
+ const parser::DefinedOperator::IntrinsicOperator &);
+ void CheckReductionTypeList(const parser::OmpClause::Reduction &);
+ void CheckReductionArraySection(const parser::OmpObjectList &ompObjectList);
+ void CheckIntentInPointerAndDefinable(
+ const parser::OmpObjectList &, const llvm::omp::Clause);
+ void CheckArraySection(const parser::ArrayElement &arrayElement,
+ const parser::Name &name, const llvm::omp::Clause clause);
+ void CheckMultipleAppearanceAcrossContext(
+ const parser::OmpObjectList &ompObjectList);
};
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_
diff --git a/lib/Semantics/resolve-directives.cpp b/lib/Semantics/resolve-directives.cpp
index 27311db..8f12278 100644
--- a/lib/Semantics/resolve-directives.cpp
+++ b/lib/Semantics/resolve-directives.cpp
@@ -365,6 +365,32 @@
x.u);
return false;
}
+
+ bool Pre(const parser::OmpClause::Reduction &x) {
+ const parser::OmpReductionOperator &opr{
+ std::get<parser::OmpReductionOperator>(x.v.t)};
+ if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) {
+ if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
+ if (!name->symbol) {
+ const auto namePair{currScope().try_emplace(
+ name->source, Attrs{}, ProcEntityDetails{})};
+ auto &symbol{*namePair.first->second};
+ name->symbol = &symbol;
+ name->symbol->set(Symbol::Flag::OmpReduction);
+ AddToContextObjectWithDSA(*name->symbol, Symbol::Flag::OmpReduction);
+ }
+ }
+ if (const auto *procRef{
+ parser::Unwrap<parser::ProcComponentRef>(procD->u)}) {
+ ResolveOmp(*procRef->v.thing.component.symbol,
+ Symbol::Flag::OmpReduction, currScope());
+ }
+ }
+ const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
+ ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction);
+ return false;
+ }
+
bool Pre(const parser::OmpAlignedClause &x) {
const auto &alignedNameList{std::get<std::list<parser::Name>>(x.t)};
ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned);
diff --git a/test/Semantics/omp-reduction01.f90 b/test/Semantics/omp-reduction01.f90
new file mode 100644
index 0000000..f518583
--- /dev/null
+++ b/test/Semantics/omp-reduction01.f90
@@ -0,0 +1,14 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+ integer :: i
+ integer :: k = 10
+
+ !ERROR: Invalid reduction operator in REDUCTION clause.
+ !$omp parallel do reduction(**:k)
+ do i = 1, 10
+ k = k ** 1
+ end do
+ !$omp end parallel do
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction02.f90 b/test/Semantics/omp-reduction02.f90
new file mode 100644
index 0000000..1ffbac3
--- /dev/null
+++ b/test/Semantics/omp-reduction02.f90
@@ -0,0 +1,37 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+
+ integer :: i
+ integer :: k = 10
+ integer :: j = 10
+
+ !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+ !$omp parallel do reduction(+:k), reduction(-:k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+ !$omp parallel do reduction(+:k), reduction(-:j), reduction(+:k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+ !$omp parallel do reduction(+:j), reduction(-:k), reduction(+:k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+ !$omp parallel do reduction(+:j), reduction(-:k), private(k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction03.f90 b/test/Semantics/omp-reduction03.f90
new file mode 100644
index 0000000..d287656
--- /dev/null
+++ b/test/Semantics/omp-reduction03.f90
@@ -0,0 +1,18 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+
+subroutine omp_target(p)
+ integer, pointer, intent(in) :: p
+
+ integer :: i
+ integer :: k = 10
+
+ !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a REDUCTION clause
+ !$omp parallel do reduction(+:p)
+ do i = 1, 10
+ k= k + 1
+ end do
+ !$omp end parallel do
+
+end subroutine omp_target
diff --git a/test/Semantics/omp-reduction04.f90 b/test/Semantics/omp-reduction04.f90
new file mode 100644
index 0000000..5441b2b
--- /dev/null
+++ b/test/Semantics/omp-reduction04.f90
@@ -0,0 +1,22 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_Reduction
+ integer :: i
+ integer, parameter :: k = 10
+ common /c/ a, b
+
+ !ERROR: Variable 'k' on the REDUCTION clause is not definable
+ !$omp parallel do reduction(+:k)
+ do i = 1, 10
+ l = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: Variable 'c' on the REDUCTION clause is not definable
+ !$omp parallel do reduction(-:/c/)
+ do i = 1, 10
+ l = k + 1
+ end do
+ !$omp end parallel do
+end program omp_Reduction
diff --git a/test/Semantics/omp-reduction05.f90 b/test/Semantics/omp-reduction05.f90
new file mode 100644
index 0000000..bccd930
--- /dev/null
+++ b/test/Semantics/omp-reduction05.f90
@@ -0,0 +1,38 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+
+program omp_reduction
+
+ integer :: i
+ integer :: k = 10
+ integer :: a(10),b(10,10,10)
+
+ !ERROR: 'a' in REDUCTION clause is a zero size array section
+ !$omp parallel do reduction(+:a(1:0:2))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: 'a' in REDUCTION clause is a zero size array section
+ !$omp parallel do reduction(+:a(1:0))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: 'b' in REDUCTION clause is a zero size array section
+ !$omp parallel do reduction(+:b(1:6,5,1:0))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: 'b' in REDUCTION clause is a zero size array section
+ !$omp parallel do reduction(+:b(1:6,1:0:5,1:10))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction06.f90 b/test/Semantics/omp-reduction06.f90
new file mode 100644
index 0000000..9d9ad24
--- /dev/null
+++ b/test/Semantics/omp-reduction06.f90
@@ -0,0 +1,31 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+
+program omp_reduction
+
+ integer :: i
+ integer :: k = 10
+ integer :: a(10), b(10,10,10)
+
+ !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+ !$omp parallel do reduction(+:a(1:10:3))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+ !$omp parallel do reduction(+:b(1:10:3,1:8:1,1:5:1))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+
+ !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+ !$omp parallel do reduction(+:b(1:10:1,1:8:2,1:5:1))
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end parallel do
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction07.f90 b/test/Semantics/omp-reduction07.f90
new file mode 100644
index 0000000..30dc5c5
--- /dev/null
+++ b/test/Semantics/omp-reduction07.f90
@@ -0,0 +1,113 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+
+ integer :: i,j,l
+ integer :: k = 10
+ !$omp parallel private(k)
+ !ERROR: REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+ !$omp do reduction(+:k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end do
+ !$omp end parallel
+
+
+ !$omp parallel private(j),reduction(-:k)
+ !ERROR: REDUCTION variable 'k' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+ !$omp do reduction(+:k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end do
+ !$omp end parallel
+
+ !$omp parallel private(j),firstprivate(k)
+ !ERROR: REDUCTION variable 'k' is FIRSTPRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+ !$omp do reduction(min:k)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end do
+ !$omp end parallel
+
+
+ !$omp parallel private(l,j),firstprivate(k)
+ !ERROR: REDUCTION variable 'k' is FIRSTPRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+ !ERROR: REDUCTION variable 'j' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+ !$omp sections reduction(ior:k) reduction(-:j)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end sections
+ !$omp end parallel
+
+!$omp sections private(k)
+ !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region
+ !ERROR: REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+ !$omp do reduction(+:k) reduction(max:j)
+ do i = 1, 10
+ k = k + 1
+ end do
+ !$omp end do
+!$omp end sections
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp sections reduction(-:a)
+a = 10
+!$omp end sections
+!$omp end parallel
+
+!$omp parallel reduction(-:a)
+!$omp end parallel
+
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION clause is not allowed on the WORKSHARE directive
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp workshare reduction(-:a)
+a = 10
+!$omp end workshare
+!$omp end parallel
+
+!$omp parallel reduction(-:a)
+!$omp end parallel
+
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION clause is not allowed on the SINGLE directive
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp single reduction(-:a)
+a = 10
+!$omp end single
+!$omp end parallel
+
+!$omp parallel reduction(-:a)
+!$omp end parallel
+
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION clause is not allowed on the SINGLE directive
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp single reduction(iand:a)
+a = 10
+!$omp end single
+!$omp end parallel
+
+!$omp parallel reduction(iand:a)
+!$omp end parallel
+
+!$omp parallel reduction(ieor:a)
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp sections reduction(-:a)
+a = 10
+!$omp end sections
+!$omp end parallel
+
+!$omp parallel reduction(ieor:a)
+!$omp end parallel
+
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction08.f90 b/test/Semantics/omp-reduction08.f90
new file mode 100644
index 0000000..c2c2d49
--- /dev/null
+++ b/test/Semantics/omp-reduction08.f90
@@ -0,0 +1,63 @@
+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause Positive cases
+
+!DEF: /omp_reduction MainProgram
+program omp_reduction
+ !DEF: /omp_reduction/i ObjectEntity INTEGER(4)
+ integer i
+ !DEF: /omp_reduction/k ObjectEntity INTEGER(4)
+ integer :: k = 10
+ !DEF: /omp_reduction/m ObjectEntity INTEGER(4)
+ integer :: m = 12
+ !$omp parallel do reduction(max:k)
+ !DEF: /omp_reduction/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block1/k (OmpReduction) HostAssoc INTEGER(4)
+ !DEF: /omp_reduction/max ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+ !REF: /omp_reduction/m
+ k = max(k, m)
+ end do
+ !$omp end parallel do
+
+ !$omp parallel do reduction(min:k)
+ !DEF: /omp_reduction/Block2/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block2/k (OmpReduction) HostAssoc INTEGER(4)
+ !DEF: /omp_reduction/min ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+ !REF: /omp_reduction/m
+ k = min(k, m)
+ end do
+ !$omp end parallel do
+
+ !$omp parallel do reduction(iand:k)
+ !DEF: /omp_reduction/Block3/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block3/k (OmpReduction) HostAssoc INTEGER(4)
+ !DEF: /omp_reduction/iand ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+ !REF: /omp_reduction/m
+ k = iand(k, m)
+ end do
+ !$omp end parallel do
+
+ !$omp parallel do reduction(ior:k)
+ !DEF: /omp_reduction/Block4/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block4/k (OmpReduction) HostAssoc INTEGER(4)
+ !DEF: /omp_reduction/ior ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+ !REF: /omp_reduction/m
+ k = ior(k, m)
+ end do
+ !$omp end parallel do
+
+ !$omp parallel do reduction(ieor:k)
+ !DEF: /omp_reduction/Block5/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block5/k (OmpReduction) HostAssoc INTEGER(4)
+ !DEF: /omp_reduction/ieor ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+ !REF: /omp_reduction/m
+ k = ieor(k,m)
+ end do
+ !$omp end parallel do
+
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction09.f90 b/test/Semantics/omp-reduction09.f90
new file mode 100644
index 0000000..5612d1a
--- /dev/null
+++ b/test/Semantics/omp-reduction09.f90
@@ -0,0 +1,86 @@
+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause Positive cases.
+!DEF: /omp_reduction MainProgram
+program omp_reduction
+ !DEF: /omp_reduction/i ObjectEntity INTEGER(4)
+ integer i
+ !DEF: /omp_reduction/k ObjectEntity INTEGER(4)
+ integer :: k = 10
+ !DEF: /omp_reduction/a ObjectEntity INTEGER(4)
+ integer a(10)
+ !DEF: /omp_reduction/b ObjectEntity INTEGER(4)
+ integer b(10,10,10)
+
+ !$omp parallel shared(k)
+ !$omp do reduction(+:k)
+ !DEF: /omp_reduction/Block1/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block1/Block1/k (OmpReduction) HostAssoc INTEGER(4)
+ k = k+1
+ end do
+ !$omp end do
+ !$omp end parallel
+
+
+ !$omp parallel do reduction(+:a(10))
+ !DEF: /omp_reduction/Block2/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !REF: /omp_reduction/k
+ k = k+1
+ end do
+ !$omp end parallel do
+
+
+ !$omp parallel do reduction(+:a(1:10:1))
+ !DEF: /omp_reduction/Block3/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !REF: /omp_reduction/k
+ k = k+1
+ end do
+ !$omp end parallel do
+
+ !$omp parallel do reduction(+:b(1:10:1,1:5,2))
+ !DEF: /omp_reduction/Block4/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !REF: /omp_reduction/k
+ k = k+1
+ end do
+ !$omp end parallel do
+
+ !$omp parallel do reduction(+:b(1:10:1,1:5,2:5:1))
+ !DEF: /omp_reduction/Block5/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !REF: /omp_reduction/k
+ k = k+1
+ end do
+ !$omp end parallel do
+
+ !$omp parallel private(i)
+ !$omp do reduction(+:k) reduction(+:j)
+ !DEF: /omp_reduction/Block6/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block6/Block1/k (OmpReduction) HostAssoc INTEGER(4)
+ k = k+1
+ end do
+ !$omp end do
+ !$omp end parallel
+
+ !$omp do reduction(-:k) reduction(*:j) reduction(-:l)
+ !DEF: /omp_reduction/Block7/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block7/k (OmpReduction) HostAssoc INTEGER(4)
+ k = k+1
+ end do
+ !$omp end do
+
+
+ !$omp do reduction(.and.:k) reduction(.or.:j) reduction(.eqv.:l)
+ !DEF: /omp_reduction/Block8/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+ do i=1,10
+ !DEF: /omp_reduction/Block8/k (OmpReduction) HostAssoc INTEGER(4)
+ k = k+1
+ end do
+ !$omp end do
+
+end program omp_reduction
diff --git a/test/Semantics/omp-reduction10.f90 b/test/Semantics/omp-reduction10.f90
new file mode 100644
index 0000000..cecbf54
--- /dev/null
+++ b/test/Semantics/omp-reduction10.f90
@@ -0,0 +1,15 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+
+ integer :: i
+ integer :: k = 10
+
+ !ERROR: Invalid reduction identifier in REDUCTION clause.
+ !$omp parallel do reduction(foo:k)
+ do i = 1, 10
+ k = foo(k)
+ end do
+ !$omp end parallel do
+end program omp_reduction
diff --git a/test/Semantics/omp-symbol08.f90 b/test/Semantics/omp-symbol08.f90
index 1fb2a86..233e367 100644
--- a/test/Semantics/omp-symbol08.f90
+++ b/test/Semantics/omp-symbol08.f90
@@ -143,7 +143,7 @@
!REF: /dotprod/block_size
!REF: /dotprod/n
do i=i0,min(i0+block_size, n)
- !REF: /dotprod/sum
+ !DEF: /dotprod/Block1/Block1/Block1/Block1/sum (OmpReduction) HostAssoc REAL(4)
!REF: /dotprod/b
!REF: /dotprod/Block1/Block1/Block1/Block1/i
!REF: /dotprod/c
