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 @@ -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/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 @@ -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/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 @@ -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(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(dOpr.u)}; + ok = CheckIntrinsicOperator(intrinsicOp); + }, + [&](const parser::ProcedureDesignator &procD) { + const parser::Name *name{std::get_if(&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(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(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(ompObject)}) { + if (const auto *arrayElement{ + parser::Unwrap(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(clause->u)}; + objList = &pClause.v; + } else if (type == llvm::omp::Clause::OMPC_firstprivate) { + const auto &fpClause{ + std::get(clause->u)}; + objList = &fpClause.v; + } else if (type == llvm::omp::Clause::OMPC_lastprivate) { + const auto &lpClause{ + std::get(clause->u)}; + objList = &lpClause.v; + } else if (type == llvm::omp::Clause::OMPC_reduction) { + const auto &rClause{std::get(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(ompObject)}) { + if (const auto *symbol{name->symbol}) { + for (const auto &redOmpObject : redObjectList.v) { + if (const auto *rname{ + parser::Unwrap(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(&designator.u)) { - if ((parser::Unwrap(ompObject)) || - (parser::Unwrap(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(ompObject)) || + (parser::Unwrap(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>( &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 &arr, - const parser::Name &name) { - for (const auto &subscript : arr.value().subscripts) { - if (const auto *triplet{ - std::get_if(&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(&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/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/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(x.v.t)}; + if (const auto *procD{parser::Unwrap(opr.u)}) { + if (const auto *name{parser::Unwrap(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(procD->u)}) { + ResolveOmp(*procRef->v.thing.component.symbol, + Symbol::Flag::OmpReduction, currScope()); + } + } + const auto &objList{std::get(x.v.t)}; + ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction); + return false; + } + bool Pre(const parser::OmpAlignedClause &x) { const auto &alignedNameList{std::get>(x.t)}; ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned); 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,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/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,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/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: 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/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,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/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,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/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,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/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,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/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,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/flang/test/Semantics/omp-reduction09.f90 b/flang/test/Semantics/omp-reduction09.f90 new file mode 100644 --- /dev/null +++ b/flang/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/flang/test/Semantics/omp-reduction10.f90 b/flang/test/Semantics/omp-reduction10.f90 new file mode 100644 --- /dev/null +++ b/flang/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/flang/test/Semantics/omp-symbol08.f90 b/flang/test/Semantics/omp-symbol08.f90 --- a/flang/test/Semantics/omp-symbol08.f90 +++ b/flang/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