diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -56,7 +56,10 @@ const PC *clause{nullptr}; std::multimap clauseInfo; std::list actualClauses; + std::list reductionSymbols; }; + bool FindReductionVariable(Symbol *symbol); + void CheckPrivateReductionVariable(Symbol *symbol); // back() is the top of the stack DirectiveContext &GetContext() { @@ -186,6 +189,33 @@ std::string ClauseSetToString(const common::EnumSet set); }; +template +bool DirectiveStructureChecker::FindReductionVariable( + Symbol *symbol) { + if (std::find(GetContext().reductionSymbols.begin(), + GetContext().reductionSymbols.end(), + symbol) != GetContext().reductionSymbols.end()) { + return true; + } + GetContext().reductionSymbols.push_back(symbol); + return false; +} +template +void DirectiveStructureChecker::CheckPrivateReductionVariable(Symbol *symbol) { + if (!GetContext().reductionSymbols.empty()) { + for (auto rs : GetContext().reductionSymbols) { + if (rs && rs->name() == symbol->name()) { + context_.Say(GetContext().clauseSource, + "A list item that appears in a REDUCTION clause" + " of a worksharing construct must be shared in" + " the parallel regions to which any of the worksharing" + " regions arising from the worksharing construct bind."_err_en_US, + ContextDirectiveAsFortran()); + } + } + } +} // Check that only clauses included in the given set are present after the given // clause. template diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -162,8 +162,15 @@ void Enter(const parser::OmpReductionClause &); void Enter(const parser::OmpScheduleClause &); -private: + void CheckPrivateClauseRestrictions(const parser::OmpObjectList &); + bool CheckReductionOperators(const parser::OmpReductionClause &); + void CheckReductionTypeList(const parser::OmpReductionClause &); + void CheckReductionVariableDefinable(Symbol &); + void CheckReductionVariableIntentIn(Symbol &); + void CheckMultipleReductionVariable(Symbol *); + void CheckReductionArrayVariable(const parser::ArrayElement &); +private: bool HasInvalidWorksharingNesting( const parser::CharBlock &, const OmpDirectiveSet &); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -407,8 +407,29 @@ 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); + CheckPrivateClauseRestrictions(x.v); +} +void OmpStructureChecker::CheckPrivateClauseRestrictions( + const parser::OmpObjectList &objList) { + for (const auto &ompObject : objList.v) { + std::visit( + common::visitors{ + [&](const parser::Designator &designator) { + if (std::get_if(&designator.u)) { + if (const auto *name{parser::Unwrap(ompObject)}) { + Symbol *symbol = name->symbol; + if (symbol) { + CheckPrivateReductionVariable(symbol); + } + } + } + }, + [&](const parser::Name &name) {}, + }, + ompObject.u); + } } void OmpStructureChecker::Enter(const parser::OmpClause::Safelen &x) { CheckAllowed(llvm::omp::Clause::OMPC_safelen); @@ -566,10 +587,123 @@ void OmpStructureChecker::Enter(const parser::OmpProcBindClause &) { CheckAllowed(llvm::omp::Clause::OMPC_proc_bind); } -void OmpStructureChecker::Enter(const parser::OmpReductionClause &) { +void OmpStructureChecker::Enter(const parser::OmpReductionClause &x) { CheckAllowed(llvm::omp::Clause::OMPC_reduction); + if (CheckReductionOperators(x)) { + CheckReductionTypeList(x); + } +} +bool OmpStructureChecker::CheckReductionOperators( + const parser::OmpReductionClause &x) { + const auto &definedOp{std::get<0>(x.t)}; + const auto &opr{std::get(definedOp.u)}; + const auto &intrinsicOp{ + std::get(opr.u)}; + switch (intrinsicOp) { + 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::OmpReductionClause &x) { + + const auto &objList{std::get<1>(x.t)}; + for (const auto &ompObject : objList) { + std::visit( + common::visitors{ + [&](const parser::DataRef &dataRef) { + if (const auto *name{parser::Unwrap(ompObject)}) { + Symbol *symbol = name->symbol; + if (symbol) { + CheckReductionVariableDefinable(*symbol); + CheckReductionVariableIntentIn(*symbol); + CheckMultipleReductionVariable(symbol); + } + } + if (const auto *arrayElement{ + parser::Unwrap(ompObject)}) { + if (arrayElement) { + CheckReductionArrayVariable(*arrayElement); + } + } + }, + [&](const parser::Substring &ss) {}, + }, + ompObject.u); + } +} +void OmpStructureChecker::CheckMultipleReductionVariable( + Symbol *reductionSymbol) { + + if (FindReductionVariable(reductionSymbol)) { + context_.Say(GetContext().clauseSource, + "A list item can appear only once in the" + " REDUCTION clause."_err_en_US, + ContextDirectiveAsFortran()); + } +} +void OmpStructureChecker::CheckReductionVariableIntentIn(Symbol &symbol) { + if (IsPointer(symbol) && IsIntentIn(symbol)) { + context_.Say(GetContext().clauseSource, + "A pointer with the INTENT(IN) attribute may not appear" + " in the REDUCTION clause."_err_en_US, + ContextDirectiveAsFortran()); + } +} +void OmpStructureChecker::CheckReductionVariableDefinable(Symbol &symbol) { + if (IsNamedConstant(symbol)) { + context_.Say(GetContext().clauseSource, + "A list item that appears in a REDUCTION clause" + " must be definable."_err_en_US, + ContextDirectiveAsFortran()); + } +} +void OmpStructureChecker::CheckReductionArrayVariable( + const parser::ArrayElement &arrayElement) { + if (!arrayElement.subscripts.empty()) { + auto iter{arrayElement.subscripts.begin()}; + if (auto *triplet{std::get_if(&iter->u)}) { + if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) { + const auto &lowerExpr{std::get<0>(triplet->t).value()}; + const auto *lb{semantics::GetExpr(lowerExpr.thing.thing)}; + auto lower{evaluate::ToInt64(*lb)}; + const auto &upperExpr{std::get<1>(triplet->t).value()}; + const auto *ub{semantics::GetExpr(upperExpr.thing.thing)}; + auto upper{evaluate::ToInt64(*ub)}; + if (lower && upper) { + if (lower > upper) { + context_.Say(GetContext().clauseSource, + "A list item that appears in a REDUCTION clause" + " cannot have a zero-length array section."_err_en_US, + ContextDirectiveAsFortran()); + } else if (std::get<2>(triplet->t)) { + const auto &strideExpr{std::get<2>(triplet->t).value()}; + const auto *st{semantics::GetExpr(strideExpr.thing.thing)}; + auto stride{evaluate::ToInt64(*st)}; + if ((stride && stride != 1)) { + context_.Say(GetContext().clauseSource, + "A list item that appears in a REDUCTION clause" + " should have a continuous storage array section."_err_en_US, + ContextDirectiveAsFortran()); + } + } + } + } + } + } +} bool OmpStructureChecker::ScheduleModifierHasType( const parser::OmpScheduleClause &x, const parser::OmpScheduleModifierType::ModType &type) { diff --git a/flang/test/Semantics/omp-reduction01.f90 b/flang/test/Semantics/omp-reduction01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction01.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 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/flang/test/Semantics/omp-reduction02.f90 b/flang/test/Semantics/omp-reduction02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction02.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 :: j = 10 + + !ERROR: A list item can appear only once in the REDUCTION clause. + !$omp parallel do reduction(+:k), reduction(-:k) + do i = 1, 10 + k = k + 1 + end do + !$omp end parallel do + + !ERROR: A list item can appear only once in the REDUCTION clause. + !$omp parallel do reduction(+:k), reduction(-:j), reduction(+:k) + do i = 1, 10 + k = k + 1 + end do + !$omp end parallel do + + !ERROR: A list item can appear only once in the REDUCTION clause. + !$omp parallel do reduction(+:j), reduction(-:k), reduction(+:k) + do i = 1, 10 + k = k + 1 + end do + !$omp end parallel do + +end program omp_reduction diff --git a/flang/test/Semantics/omp-reduction03.f90 b/flang/test/Semantics/omp-reduction03.f90 new file mode 100644 --- /dev/null +++ b/flang/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: A pointer with the INTENT(IN) attribute may not appear in the 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/flang/test/Semantics/omp-reduction04.f90 b/flang/test/Semantics/omp-reduction04.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction04.f90 @@ -0,0 +1,17 @@ +!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 + + !ERROR: A list item that appears in a REDUCTION clause must be definable. + !$omp parallel do reduction(+:k) + do i = 1, 10 + l = k + 1 + end do + !$omp end parallel do + + print *, k +end program omp_Reduction diff --git a/flang/test/Semantics/omp-reduction05.f90 b/flang/test/Semantics/omp-reduction05.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction05.f90 @@ -0,0 +1,25 @@ +!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) + + !ERROR: A list item that appears in a REDUCTION clause cannot have a zero-length 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 list item that appears in a REDUCTION clause cannot have a zero-length array section. + !$omp parallel do reduction(+:a(1:0)) + do i = 1, 10 + k = k + 1 + end do + !$omp end parallel do + +end program omp_reduction diff --git a/flang/test/Semantics/omp-reduction06.f90 b/flang/test/Semantics/omp-reduction06.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction06.f90 @@ -0,0 +1,18 @@ +!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) + + !ERROR: A list item that appears in a REDUCTION clause should have a continuous storage array section. + !$omp parallel do reduction(+:a(1:10:3)) + do i = 1, 10 + k = k + 1 + end do + !$omp end parallel do + +end program omp_reduction diff --git a/flang/test/Semantics/omp-reduction07.f90 b/flang/test/Semantics/omp-reduction07.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction07.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: A list item that appears in a REDUCTION clause of a worksharing construct must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind. + !$omp parallel do reduction(+:k), private(k) + do i = 1, 10 + k = k + 1 + end do + !$omp end parallel do +end program omp_reduction diff --git a/flang/test/Semantics/omp-reduction08.f90 b/flang/test/Semantics/omp-reduction08.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-reduction08.f90 @@ -0,0 +1,57 @@ +!RUN: %S/test_errors.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) + +!$omp parallel do reduction(+:k) shared(k) + !DEF: /omp_reduction/Block1/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) + !DEF: /omp_reduction/Block1/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(10)) + !DEF: /omp_reduction/Block1/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/Block1/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 private(i), shared(k), reduction(+:k) +!$omp& reduction(+:j) + !DEF: /omp_reduction/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + !REF: /omp_reduction/k + k = k+1 + end do + +end program omp_reduction