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 @@ -208,11 +208,11 @@ const parser::OmpObjectList &, const llvm::omp::Clause); void GetSymbolsInObjectList( const parser::OmpObjectList &, std::vector &); - const parser::Name GetLoopIndex(const parser::DoConstruct *x); void SetLoopInfo(const parser::OpenMPLoopConstruct &x); void CheckIsLoopIvPartOfClause( llvmOmpClause clause, const parser::OmpObjectList &ompObjectList); + void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock); }; } // 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 @@ -37,6 +37,53 @@ CheckAllowed(llvm::omp::Y); \ } +// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment +// statements and the expressions enclosed in an OpenMP Workshare construct +class OmpWorkshareBlockChecker { +public: + OmpWorkshareBlockChecker(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(var)}; + const auto *rhs{GetExpr(expr)}; + 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 WORKSHARE construct"_err_en_US); + } + return true; + } + + bool Pre(const parser::Expr &expr) { + if (const auto *e{GetExpr(expr)}) { + for (const Symbol &symbol : evaluate::CollectSymbols(*e)) { + const Symbol &root{GetAssociationRoot(symbol)}; + if (IsFunction(root) && + !(root.attrs().test(Attr::ELEMENTAL) || + root.attrs().test(Attr::INTRINSIC))) { + context_.Say(expr.source, + "User defined non-ELEMENTAL function " + "'%s' is not allowed in a WORKSHARE construct"_err_en_US, + root.name()); + } + } + } + return false; + } + +private: + SemanticsContext &context_; + parser::CharBlock source_; +}; + bool OmpStructureChecker::HasInvalidWorksharingNesting( const parser::CharBlock &source, const OmpDirectiveSet &set) { // set contains all the invalid closely nested directives @@ -149,6 +196,15 @@ PushContextAndClauseSets(beginDir.source, beginDir.v); CheckNoBranching(block, beginDir.v, beginDir.source); + + switch (beginDir.v) { + case llvm::omp::OMPD_workshare: + case llvm::omp::OMPD_parallel_workshare: + CheckWorkshareBlockStmts(block, beginDir.source); + break; + default: + break; + } } void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) { @@ -835,4 +891,82 @@ } } +void OmpStructureChecker::CheckWorkshareBlockStmts( + const parser::Block &block, parser::CharBlock source) { + OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source}; + + for (auto it{block.begin()}; it != block.end(); ++it) { + if (parser::Unwrap(*it) || + parser::Unwrap(*it) || + parser::Unwrap(*it) || + parser::Unwrap(*it) || + parser::Unwrap(*it)) { + parser::Walk(*it, ompWorkshareBlockChecker); + } else if (const auto *ompConstruct{ + parser::Unwrap(*it)}) { + if (const auto *ompAtomicConstruct{ + std::get_if(&ompConstruct->u)}) { + // Check if assignment statements in the enclosing OpenMP Atomic + // construct are allowed in the Workshare construct + parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker); + } else if (const auto *ompCriticalConstruct{ + std::get_if( + &ompConstruct->u)}) { + // All the restrictions on the Workshare construct apply to the + // statements in the enclosing critical constructs + const auto &criticalBlock{ + std::get(ompCriticalConstruct->t)}; + CheckWorkshareBlockStmts(criticalBlock, source); + } else { + // Check if OpenMP constructs enclosed in the Workshare construct are + // 'Parallel' constructs + auto currentDir{llvm::omp::Directive::OMPD_unknown}; + const OmpDirectiveSet parallelDirSet{ + llvm::omp::Directive::OMPD_parallel, + llvm::omp::Directive::OMPD_parallel_do, + llvm::omp::Directive::OMPD_parallel_sections, + llvm::omp::Directive::OMPD_parallel_workshare, + llvm::omp::Directive::OMPD_parallel_do_simd}; + + if (const auto *ompBlockConstruct{ + std::get_if(&ompConstruct->u)}) { + const auto &beginBlockDir{ + std::get(ompBlockConstruct->t)}; + const auto &beginDir{ + std::get(beginBlockDir.t)}; + currentDir = beginDir.v; + } else if (const auto *ompLoopConstruct{ + std::get_if( + &ompConstruct->u)}) { + const auto &beginLoopDir{ + std::get(ompLoopConstruct->t)}; + const auto &beginDir{ + std::get(beginLoopDir.t)}; + currentDir = beginDir.v; + } else if (const auto *ompSectionsConstruct{ + std::get_if( + &ompConstruct->u)}) { + const auto &beginSectionsDir{ + std::get( + ompSectionsConstruct->t)}; + const auto &beginDir{ + std::get(beginSectionsDir.t)}; + currentDir = beginDir.v; + } + + if (!parallelDirSet.test(currentDir)) { + context_.Say(source, + "OpenMP constructs enclosed in WORKSHARE construct may consist " + "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US); + } + } + } else { + context_.Say(source, + "The structured block in a WORKSHARE construct may consist of only " + "SCALAR or ARRAY assignments, FORALL or WHERE statements, " + "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US); + } + } +} + } // namespace Fortran::semantics diff --git a/flang/test/Semantics/omp-workshare01.f90 b/flang/test/Semantics/omp-workshare01.f90 --- a/flang/test/Semantics/omp-workshare01.f90 +++ b/flang/test/Semantics/omp-workshare01.f90 @@ -1,6 +1,4 @@ ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - ! OpenMP Version 4.5 ! 2.7.4 workshare Construct ! Invalid do construct inside !$omp workshare @@ -9,14 +7,25 @@ integer n, i real aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n) + !ERROR: The structured block in a WORKSHARE construct may consist of only SCALAR or ARRAY assignments, FORALL or WHERE statements, FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs + !ERROR: OpenMP constructs enclosed in WORKSHARE construct may consist of ATOMIC, CRITICAL or PARALLEL constructs only !$omp workshare - !ERROR: Unexpected do stmt inside !$omp workshare do i = 1, n print *, "omp workshare" end do + !$omp critical + !$omp single aa = bb + !$omp end single + !$omp end critical + + !$omp parallel + !$omp single cc = dd + !$omp end single + !$omp end parallel + ee = ff !$omp end workshare diff --git a/flang/test/Semantics/omp-workshare02.f90 b/flang/test/Semantics/omp-workshare02.f90 --- a/flang/test/Semantics/omp-workshare02.f90 +++ b/flang/test/Semantics/omp-workshare02.f90 @@ -1,6 +1,4 @@ ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - ! OpenMP Version 4.5 ! 2.7.4 workshare Construct ! The !omp workshare construct must not contain any user defined @@ -8,22 +6,60 @@ module my_mod contains - function my_func(n) - integer :: my_func(n, n) + integer function my_func() my_func = 10 end function my_func end module my_mod subroutine workshare(aa, bb, cc, dd, ee, ff, n) use my_mod - integer n, i - real aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n) + integer n, i, j + real aa(n), bb(n), cc(n), dd(n), ee(n), ff(n) !$omp workshare - !ERROR: Non-ELEMENTAL function is not allowed in !$omp workshare construct - aa = my_func(n) + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + aa = my_func() cc = dd ee = ff + + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + where (aa .ne. my_func()) aa = bb * cc + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + where (dd .lt. 5) dd = aa * my_func() + + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + where (aa .ge. my_func()) + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + cc = aa + my_func() + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + elsewhere (aa .le. my_func()) + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + cc = dd + my_func() + elsewhere + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + cc = ee + my_func() + end where + + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + forall (j = 1:my_func()) aa(j) = aa(j) + bb(j) + + forall (j = 1:10) + aa(j) = aa(j) + bb(j) + + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + where (cc .le. j) cc = cc + my_func() + end forall + + !$omp atomic update + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + j = j + my_func() + + !$omp atomic capture + i = j + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct + j = j - my_func() + !$omp end atomic + !$omp end workshare end subroutine workshare diff --git a/flang/test/Semantics/omp-workshare03.f90 b/flang/test/Semantics/omp-workshare03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-workshare03.f90 @@ -0,0 +1,32 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.7.4 workshare 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_workshare + use defined_assign + + integer :: a, aa(10), bb(10) + logical :: l(10) + l = .TRUE. + + !$omp workshare + !ERROR: Defined assignment statement is not allowed in a WORKSHARE construct + a = l + aa = bb + !$omp end workshare + +end program omp_workshare diff --git a/flang/test/Semantics/omp-workshare04.f90 b/flang/test/Semantics/omp-workshare04.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-workshare04.f90 @@ -0,0 +1,48 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.7.4 workshare Construct +! Checks for OpenMP Workshare construct + +subroutine omp_workshare(aa, bb, cc, dd, ee, ff, n) + integer i, j, n, a(10), b(10) + integer, pointer :: p + integer, target :: t + real aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n) + + !ERROR: The structured block in a WORKSHARE construct may consist of only SCALAR or ARRAY assignments, FORALL or WHERE statements, FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs + !$omp workshare + p => t + + !$omp parallel + cc = dd + !$omp end parallel + + !ERROR: OpenMP constructs enclosed in WORKSHARE construct may consist of ATOMIC, CRITICAL or PARALLEL constructs only + !$omp parallel workshare + !$omp single + ee = ff + !$omp end single + !$omp end parallel workshare + + where (aa .ne. 0) cc = bb / aa + + where (b .lt. 2) b = sum(a) + + where (aa .ge. 2.0) + cc = aa + bb + elsewhere + cc = dd + ee + end where + + forall (i = 1:10, n > i) a(i) = b(i) + + forall (j = 1:10) + a(j) = a(j) + b(j) + end forall + + !$omp atomic update + j = j + sum(a) + + !$omp end workshare + +end subroutine omp_workshare diff --git a/flang/test/Semantics/omp-workshare05.f90 b/flang/test/Semantics/omp-workshare05.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-workshare05.f90 @@ -0,0 +1,60 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.7.4 workshare Construct +! Checks for OpenMP Parallel constructs enclosed in Workshare constructs + +module workshare_mod + 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 + + integer function my_func() + my_func = 10 + end function my_func + +end module workshare_mod + +program omp_workshare + use workshare_mod + + integer, parameter :: n = 10 + integer :: i, j, a(10), b(10) + integer, pointer :: p + integer, target :: t + logical :: l(10) + real :: aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n) + + !$omp workshare + + !$omp parallel + p => t + a = l + !$omp single + ee = ff + !$omp end single + !$omp end parallel + + !$omp parallel sections + !$omp section + aa = my_func() + !$omp end parallel sections + + !$omp parallel do + do i = 1, 10 + b(i) = my_func() + i + end do + !$omp end parallel do + + !$omp parallel + where (dd .lt. 5) dd = aa * my_func() + !$omp end parallel + + !$omp end workshare + +end program omp_workshare