diff --git a/flang/include/flang/Semantics/openmp-directive-sets.h b/flang/include/flang/Semantics/openmp-directive-sets.h index dd610c9702c28..35b29dca77333 100644 --- a/flang/include/flang/Semantics/openmp-directive-sets.h +++ b/flang/include/flang/Semantics/openmp-directive-sets.h @@ -143,6 +143,7 @@ static const OmpDirectiveSet topTargetSet{ Directive::OMPD_target_teams_distribute_parallel_do_simd, Directive::OMPD_target_teams_distribute_simd, Directive::OMPD_target_teams_loop, + Directive::OMPD_target_teams_workdistribute, }; static const OmpDirectiveSet allTargetSet{topTargetSet}; @@ -172,6 +173,7 @@ static const OmpDirectiveSet topTeamsSet{ Directive::OMPD_teams_distribute_parallel_do_simd, Directive::OMPD_teams_distribute_simd, Directive::OMPD_teams_loop, + Directive::OMPD_teams_workdistribute, }; static const OmpDirectiveSet bottomTeamsSet{ @@ -187,6 +189,7 @@ static const OmpDirectiveSet allTeamsSet{ Directive::OMPD_target_teams_distribute_parallel_do_simd, Directive::OMPD_target_teams_distribute_simd, Directive::OMPD_target_teams_loop, + Directive::OMPD_target_teams_workdistribute, } | topTeamsSet, }; @@ -230,6 +233,9 @@ static const OmpDirectiveSet blockConstructSet{ Directive::OMPD_taskgroup, Directive::OMPD_teams, Directive::OMPD_workshare, + Directive::OMPD_target_teams_workdistribute, + Directive::OMPD_teams_workdistribute, + Directive::OMPD_workdistribute, }; static const OmpDirectiveSet loopConstructSet{ @@ -376,6 +382,7 @@ static const OmpDirectiveSet nestedReduceWorkshareAllowedSet{ }; static const OmpDirectiveSet nestedTeamsAllowedSet{ + Directive::OMPD_workdistribute, Directive::OMPD_distribute, Directive::OMPD_distribute_parallel_do, Directive::OMPD_distribute_parallel_do_simd, diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp index d70aaab82cbab..24b9c8790a3fa 100644 --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -1567,11 +1567,16 @@ TYPE_PARSER( "TARGET DATA" >> pure(llvm::omp::Directive::OMPD_target_data), "TARGET_DATA" >> pure(llvm::omp::Directive::OMPD_target_data), "TARGET PARALLEL" >> pure(llvm::omp::Directive::OMPD_target_parallel), + "TARGET TEAMS WORKDISTRIBUTE" >> + pure(llvm::omp::Directive::OMPD_target_teams_workdistribute), "TARGET TEAMS" >> pure(llvm::omp::Directive::OMPD_target_teams), "TARGET" >> pure(llvm::omp::Directive::OMPD_target), "TASK"_id >> pure(llvm::omp::Directive::OMPD_task), "TASKGROUP" >> pure(llvm::omp::Directive::OMPD_taskgroup), + "TEAMS WORKDISTRIBUTE" >> + pure(llvm::omp::Directive::OMPD_teams_workdistribute), "TEAMS" >> pure(llvm::omp::Directive::OMPD_teams), + "WORKDISTRIBUTE" >> pure(llvm::omp::Directive::OMPD_workdistribute), "WORKSHARE" >> pure(llvm::omp::Directive::OMPD_workshare)))) TYPE_PARSER(sourced(construct( @@ -1729,6 +1734,8 @@ TYPE_PARSER(sourced( TYPE_PARSER(construct( Parser{} / endOmpLine, block, Parser{} / endOmpLine)) +#define MakeBlockConstruct(dir) \ + construct(OmpBlockConstructParser{dir}) // OMP SECTIONS Directive TYPE_PARSER(construct(first( diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index fbe89c668fc13..7e5945d0c999b 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2561,6 +2561,15 @@ class UnparseVisitor { case llvm::omp::Directive::OMPD_workshare: Word("WORKSHARE "); break; + case llvm::omp::Directive::OMPD_workdistribute: + Word("WORKDISTRIBUTE "); + break; + case llvm::omp::Directive::OMPD_teams_workdistribute: + Word("TEAMS WORKDISTRIBUTE "); + break; + case llvm::omp::Directive::OMPD_target_teams_workdistribute: + Word("TARGET TEAMS WORKDISTRIBUTE "); + break; default: // Nothing to be done break; diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 0bf2b7ee71f42..093fc7171b555 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -37,6 +37,7 @@ #include "llvm/ADT/ArrayRef.h" #include "llvm/ADT/STLExtras.h" +#include "llvm/ADT/StringExtras.h" #include "llvm/ADT/StringRef.h" #include "llvm/Frontend/OpenMP/OMP.h" @@ -141,6 +142,64 @@ class OmpWorkshareBlockChecker { parser::CharBlock source_; }; +// 'OmpWorkdistributeBlockChecker' is used to check the validity of the +// assignment statements and the expressions enclosed in an OpenMP +// WORKDISTRIBUTE construct +class OmpWorkdistributeBlockChecker { +public: + OmpWorkdistributeBlockChecker( + SemanticsContext &context, parser::CharBlock source) + : context_{context}, source_{source} {} + + template bool Pre(const T &) { return true; } + template void Post(const T &) {} + + bool Pre(const parser::AssignmentStmt &assignment) { + const auto &var{std::get(assignment.t)}; + const auto &expr{std::get(assignment.t)}; + const auto *lhs{GetExpr(context_, var)}; + const auto *rhs{GetExpr(context_, expr)}; + if (lhs && rhs) { + Tristate isDefined{semantics::IsDefinedAssignment( + lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())}; + if (isDefined == Tristate::Yes) { + context_.Say(expr.source, + "Defined assignment statement is not allowed in a WORKDISTRIBUTE construct"_err_en_US); + } + } + return true; + } + + bool Pre(const parser::Expr &expr) { + if (const auto *e{GetExpr(context_, expr)}) { + if (!e) + return false; + for (const Symbol &symbol : evaluate::CollectSymbols(*e)) { + const Symbol &root{GetAssociationRoot(symbol)}; + if (IsFunction(root)) { + std::vector attrs; + if (!IsElementalProcedure(root)) { + attrs.push_back("non-ELEMENTAL"); + } + if (root.attrs().test(Attr::IMPURE)) { + attrs.push_back("IMPURE"); + } + std::string attrsStr = + attrs.empty() ? "" : " " + llvm::join(attrs, ", "); + context_.Say(expr.source, + "User defined%s function '%s' is not allowed in a WORKDISTRIBUTE construct"_err_en_US, + attrsStr, root.name()); + } + } + } + return false; + } + +private: + SemanticsContext &context_; + parser::CharBlock source_; +}; + // `OmpUnitedTaskDesignatorChecker` is used to check if the designator // can appear within the TASK construct class OmpUnitedTaskDesignatorChecker { @@ -819,6 +878,12 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) { "TARGET construct with nested TEAMS region contains statements or " "directives outside of the TEAMS construct"_err_en_US); } + if (GetContext().directive == llvm::omp::Directive::OMPD_workdistribute && + GetContextParent().directive != llvm::omp::Directive::OMPD_teams) { + context_.Say(parser::FindSourceLocation(x), + "%s region can only be strictly nested within TEAMS region"_err_en_US, + ContextDirectiveAsFortran()); + } } CheckNoBranching(block, beginDir.v, beginDir.source); @@ -900,6 +965,17 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) { HasInvalidWorksharingNesting( beginDir.source, llvm::omp::nestedWorkshareErrSet); break; + case llvm::omp::OMPD_workdistribute: + if (!CurrentDirectiveIsNested()) { + context_.Say(beginDir.source, + "A WORKDISTRIBUTE region must be nested inside TEAMS region only."_err_en_US); + } + CheckWorkdistributeBlockStmts(block, beginDir.source); + break; + case llvm::omp::OMPD_teams_workdistribute: + case llvm::omp::OMPD_target_teams_workdistribute: + CheckWorkdistributeBlockStmts(block, beginDir.source); + break; case llvm::omp::Directive::OMPD_scope: case llvm::omp::Directive::OMPD_single: // TODO: This check needs to be extended while implementing nesting of @@ -4385,6 +4461,27 @@ void OmpStructureChecker::CheckWorkshareBlockStmts( } } +void OmpStructureChecker::CheckWorkdistributeBlockStmts( + const parser::Block &block, parser::CharBlock source) { + unsigned version{context_.langOptions().OpenMPVersion}; + unsigned since{60}; + if (version < since) + context_.Say(source, + "WORKDISTRIBUTE construct is not allowed in %s, %s"_err_en_US, + ThisVersion(version), TryVersion(since)); + + OmpWorkdistributeBlockChecker ompWorkdistributeBlockChecker{context_, source}; + + for (auto it{block.begin()}; it != block.end(); ++it) { + if (parser::Unwrap(*it)) { + parser::Walk(*it, ompWorkdistributeBlockChecker); + } else { + context_.Say(source, + "The structured block in a WORKDISTRIBUTE construct may consist of only SCALAR or ARRAY assignments"_err_en_US); + } + } +} + void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) { if (auto contig{IsContiguous(context_, object)}; contig && !*contig) { const parser::Name *name{GetObjectName(object)}; diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 6a877a5d0a7c0..637c1a4b52fda 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -242,6 +242,7 @@ class OmpStructureChecker llvmOmpClause clause, const parser::OmpObjectList &ompObjectList); bool CheckTargetBlockOnlyTeams(const parser::Block &); void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock); + void CheckWorkdistributeBlockStmts(const parser::Block &, parser::CharBlock); void CheckIteratorRange(const parser::OmpIteratorSpecifier &x); void CheckIteratorModifier(const parser::OmpIterator &x); diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 151f4ccae634e..42d24e703889e 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -1680,10 +1680,13 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) { case llvm::omp::Directive::OMPD_task: case llvm::omp::Directive::OMPD_taskgroup: case llvm::omp::Directive::OMPD_teams: + case llvm::omp::Directive::OMPD_workdistribute: case llvm::omp::Directive::OMPD_workshare: case llvm::omp::Directive::OMPD_parallel_workshare: case llvm::omp::Directive::OMPD_target_teams: + case llvm::omp::Directive::OMPD_target_teams_workdistribute: case llvm::omp::Directive::OMPD_target_parallel: + case llvm::omp::Directive::OMPD_teams_workdistribute: PushContext(beginDir.source, beginDir.v); break; default: @@ -1713,9 +1716,12 @@ void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) { case llvm::omp::Directive::OMPD_target: case llvm::omp::Directive::OMPD_task: case llvm::omp::Directive::OMPD_teams: + case llvm::omp::Directive::OMPD_workdistribute: case llvm::omp::Directive::OMPD_parallel_workshare: case llvm::omp::Directive::OMPD_target_teams: - case llvm::omp::Directive::OMPD_target_parallel: { + case llvm::omp::Directive::OMPD_target_parallel: + case llvm::omp::Directive::OMPD_target_teams_workdistribute: + case llvm::omp::Directive::OMPD_teams_workdistribute: { bool hasPrivate; for (const auto *allocName : allocateNames_) { hasPrivate = false; diff --git a/flang/test/Parser/OpenMP/workdistribute.f90 b/flang/test/Parser/OpenMP/workdistribute.f90 new file mode 100644 index 0000000000000..61c91cb47cceb --- /dev/null +++ b/flang/test/Parser/OpenMP/workdistribute.f90 @@ -0,0 +1,27 @@ +!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=60 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s +!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=60 %s | FileCheck --check-prefix="PARSE-TREE" %s + +!UNPARSE: SUBROUTINE teams_workdistribute +!UNPARSE: USE :: iso_fortran_env +!UNPARSE: REAL(KIND=4_4) a +!UNPARSE: REAL(KIND=4_4), DIMENSION(10_4) :: x +!UNPARSE: REAL(KIND=4_4), DIMENSION(10_4) :: y +!UNPARSE: !$OMP TEAMS WORKDISTRIBUTE +!UNPARSE: y=a*x+y +!UNPARSE: !$OMP END TEAMS WORKDISTRIBUTE +!UNPARSE: END SUBROUTINE teams_workdistribute + +!PARSE-TREE: | | | OmpBeginBlockDirective +!PARSE-TREE: | | | | OmpBlockDirective -> llvm::omp::Directive = teams workdistribute +!PARSE-TREE: | | | OmpEndBlockDirective +!PARSE-TREE: | | | | OmpBlockDirective -> llvm::omp::Directive = teams workdistribute + +subroutine teams_workdistribute() + use iso_fortran_env + real(kind=real32) :: a + real(kind=real32), dimension(10) :: x + real(kind=real32), dimension(10) :: y + !$omp teams workdistribute + y = a * x + y + !$omp end teams workdistribute +end subroutine teams_workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute01.f90 b/flang/test/Semantics/OpenMP/workdistribute01.f90 new file mode 100644 index 0000000000000..f7e36976dfb65 --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute01.f90 @@ -0,0 +1,16 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60 +! OpenMP Version 6.0 +! workdistribute Construct +! Invalid do construct inside !$omp workdistribute + +subroutine workdistribute() + integer n, i + !ERROR: A WORKDISTRIBUTE region must be nested inside TEAMS region only. + !ERROR: The structured block in a WORKDISTRIBUTE construct may consist of only SCALAR or ARRAY assignments + !$omp workdistribute + do i = 1, n + print *, "omp workdistribute" + end do + !$omp end workdistribute + +end subroutine workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute02.f90 b/flang/test/Semantics/OpenMP/workdistribute02.f90 new file mode 100644 index 0000000000000..6de3a55f545b5 --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute02.f90 @@ -0,0 +1,34 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60 +! OpenMP Version 6.0 +! workdistribute Construct +! The !omp workdistribute construct must not contain any user defined +! function calls unless the function is ELEMENTAL. + +module my_mod + contains + integer function my_func() + my_func = 10 + end function my_func + + impure integer function impure_my_func() + impure_my_func = 20 + end function impure_my_func + + impure elemental integer function impure_ele_my_func() + impure_ele_my_func = 20 + end function impure_ele_my_func +end module my_mod + +subroutine workdistribute(aa, bb, cc, n) + use my_mod + integer n + real aa(n), bb(n), cc(n) + !$omp teams + !$omp workdistribute + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKDISTRIBUTE construct + aa = my_func() + aa = bb * cc + !$omp end workdistribute + !$omp end teams + +end subroutine workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute03.f90 b/flang/test/Semantics/OpenMP/workdistribute03.f90 new file mode 100644 index 0000000000000..828170a016ed2 --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute03.f90 @@ -0,0 +1,34 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60 +! OpenMP Version 6.0 +! workdistribute Construct +! All array assignments, scalar assignments, and masked array assignments +! must be intrinsic assignments. + +module defined_assign + interface assignment(=) + module procedure work_assign + end interface + + contains + subroutine work_assign(a,b) + integer, intent(out) :: a + logical, intent(in) :: b(:) + end subroutine work_assign +end module defined_assign + +program omp_workdistribute + use defined_assign + + integer :: a, aa(10), bb(10) + logical :: l(10) + l = .TRUE. + + !$omp teams + !$omp workdistribute + !ERROR: Defined assignment statement is not allowed in a WORKDISTRIBUTE construct + a = l + aa = bb + !$omp end workdistribute + !$omp end teams + +end program omp_workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute04.f90 b/flang/test/Semantics/OpenMP/workdistribute04.f90 new file mode 100644 index 0000000000000..d407e8a073ae4 --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute04.f90 @@ -0,0 +1,15 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50 +! OpenMP Version 6.0 +! workdistribute Construct +! Unsuported OpenMP version + +subroutine teams_workdistribute() + use iso_fortran_env + real(kind=real32) :: a + real(kind=real32), dimension(10) :: x + real(kind=real32), dimension(10) :: y + !ERROR: WORKDISTRIBUTE construct is not allowed in OpenMP v5.0, try -fopenmp-version=60 + !$omp teams workdistribute + y = a * x + y + !$omp end teams workdistribute +end subroutine teams_workdistribute