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 @@ -134,8 +134,11 @@ const PC *clause{nullptr}; std::multimap clauseInfo; std::list actualClauses; + std::list reductionSymbols; }; + bool FindReductionVariable(Symbol *symbol); + bool CheckPrivateReductionVariable(Symbol *symbol); // back() is the top of the stack DirectiveContext &GetContext() { CHECK(!dirContext_.empty()); @@ -155,6 +158,7 @@ GetContext().allowedExclusiveClauses = {}; GetContext().requiredClauses = {}; GetContext().clauseInfo = {}; + GetContext().reductionSymbols.clear(); } void SetContextDirectiveSource(const parser::CharBlock &directive) { @@ -266,6 +270,29 @@ 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 +bool DirectiveStructureChecker::CheckPrivateReductionVariable(Symbol *symbol) { + if (!GetContext().reductionSymbols.empty()) { + for (auto rs : GetContext().reductionSymbols) { + if (rs && rs->name() == symbol->name()) { + return true; + } + } + } + return false; +} template void DirectiveStructureChecker::CheckNoBranching( const parser::Block &block, D directive, 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 @@ -187,6 +187,15 @@ const common::Indirection &, const parser::Name &); void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList); + void CheckPrivateClauseRestrictions(const parser::OmpObjectList &); + bool CheckReductionOperators(const parser::OmpReductionClause &); + bool CheckIntrinsicOperator( + const parser::DefinedOperator::IntrinsicOperator &); + void CheckReductionTypeList(const parser::OmpReductionClause &); + void CheckReductionVariableDefinable(Symbol &); + void CheckReductionVariableIntentIn(Symbol &); + void CheckMultipleReductionVariable(Symbol *); + void CheckReductionArrayVariable(const parser::ArrayElement &); }; } // 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 @@ -395,6 +395,155 @@ // Restrictions specific to each clause are implemented apart from the // generalized restrictions. +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)}; + bool ok = false; + std::visit( + common::visitors{ + [&](const parser::DefinedOperator + &dOpr) { //:DefinedOpName &defName) {}, + 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->symbol) { + std::string procName = + parser::ToUpperCaseLetters(name->symbol->name().ToString()); + if (procName == "MAX" || procName == "MIN" || + procName == "IAND" || procName == "IOR" || + procName == "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::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()); + } + } + } + } + } + } +} + void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) { CheckAllowed(llvm::omp::Clause::OMPC_ordered); // the parameter of ordered clause is optional @@ -417,6 +566,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { CheckAllowed(llvm::omp::Clause::OMPC_private); CheckIsVarPartOfAnotherVar(x.v); + CheckPrivateClauseRestrictions(x.v); } void OmpStructureChecker::CheckIsVarPartOfAnotherVar( @@ -441,13 +591,40 @@ ompObject.u); } } +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) { + if (CheckPrivateReductionVariable(symbol)) { + 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()); + } + } + } + } + }, + [&](const parser::Name &name) {}, + }, + ompObject.u); + } +} // Following clauses have a seperate node in parse-tree.h. CHECK_SIMPLE_PARSER_CLAUSE(OmpAllocateClause, OMPC_allocate) CHECK_SIMPLE_PARSER_CLAUSE(OmpDefaultClause, OMPC_default) CHECK_SIMPLE_PARSER_CLAUSE(OmpDistScheduleClause, OMPC_dist_schedule) CHECK_SIMPLE_PARSER_CLAUSE(OmpNowait, OMPC_nowait) CHECK_SIMPLE_PARSER_CLAUSE(OmpProcBindClause, OMPC_proc_bind) -CHECK_SIMPLE_PARSER_CLAUSE(OmpReductionClause, OMPC_reduction) // Restrictions specific to each clause are implemented apart from the // generalized restrictions. 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 @@ -298,6 +298,41 @@ x.u); return false; } + + bool Pre(const parser::OmpReductionClause &x) { + const parser::OmpReductionOperator &opr{ + std::get(x.t)}; + std::visit( + common::visitors{ + [&](const parser::DefinedOperator &dOP) {}, + [&](const parser::ProcedureDesignator &procD) { + std::visit( + common::visitors{ + [&](const parser::Name &name) { + if (!name.symbol) { + //Resolving the symbol value for the procedure name + //in reduction clause. + 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); + } + }, + [&](const parser::ProcComponentRef &procRef) { + ResolveOmp(*procRef.v.thing.component.symbol, + Symbol::Flag::OmpReduction, currScope()); + }, + }, + procD.u); + }, + }, + opr.u); + 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,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,16 @@ +!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 + +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,62 @@ +!RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.3.6 Reduction Clause Positive cases + +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 + !REF: /omp_reduction/k + !DEF: /omp_reduction/max INTRINSIC (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/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + !REF: /omp_reduction/k + !DEF: /omp_reduction/max INTRINSIC (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/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + !REF: /omp_reduction/k + !DEF: /omp_reduction/max INTRINSIC (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/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + !REF: /omp_reduction/k + !DEF: /omp_reduction/max INTRINSIC (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/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + !REF: /omp_reduction/k + !DEF: /omp_reduction/max INTRINSIC (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,58 @@ +!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 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