diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 014604627f2cd..3602b08a023e6 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -598,6 +598,45 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { CheckDistLinear(x); } } + +void OmpStructureChecker::CheckSymbolsForOrderClause( + const parser::Name &name, bool checkRuntimeAPICall) { + if (!dirContext_.empty() && + (llvm::omp::allDoSet | llvm::omp::allSimdSet | + llvm::omp::allDistributeSet) + .test(GetContext().directive)) { + if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_order)}) { + const auto &orderClause{std::get(clause->u)}; + if (std::get(orderClause.v.t) == + parser::OmpOrderClause::Type::Concurrent) { + if (checkRuntimeAPICall && + llvm::StringRef(name.ToString()).starts_with_insensitive("omp_")) { + context_.Say(name.source, + "The OpenMP runtime API calls are not allowed in " + "the `order(concurrent)` clause region"_err_en_US); + } else if (name.symbol->test(Symbol::Flag::OmpThreadprivate)) { + context_.Say(name.source, + "A THREADPRIVATE variable cannot appear in an " + "`order(concurrent)` clause region, the behavior " + "is unspecified"_err_en_US); + } + } + } + } +} + +// OpenMP 5.2: 10.3 Order clause restrictions +void OmpStructureChecker::Enter(const parser::ProcedureDesignator &x) { + const auto &name{std::get(x.u)}; + CheckSymbolsForOrderClause(name, true); +} + +// OpenMP 5.2: 10.3 Order clause restrictions +void OmpStructureChecker::Enter(const parser::Designator &x) { + const auto name{parser::Unwrap(x.u)}; + CheckSymbolsForOrderClause(*name, false); +} + const parser::Name OmpStructureChecker::GetLoopIndex( const parser::DoConstruct *x) { using Bounds = parser::LoopControl::Bounds; diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index d9236be8bced4..c34ee4def296d 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -131,6 +131,9 @@ class OmpStructureChecker void Enter(const parser::OmpAtomicCapture &); void Leave(const parser::OmpAtomic &); + void Enter(const parser::ProcedureDesignator &); + void Enter(const parser::Designator &); + #define GEN_FLANG_CLAUSE_CHECK_ENTER #include "llvm/Frontend/OpenMP/OMP.inc" @@ -230,6 +233,8 @@ class OmpStructureChecker const parser::OmpObjectList &ompObjectList); void CheckPredefinedAllocatorRestriction( const parser::CharBlock &source, const parser::Name &name); + void CheckSymbolsForOrderClause( + const parser::Name &name, bool checkRuntimeAPICall); bool isPredefinedAllocator{false}; void CheckAllowedRequiresClause(llvmOmpClause clause); diff --git a/flang/test/Semantics/OpenMP/order-clause02.f90 b/flang/test/Semantics/OpenMP/order-clause02.f90 new file mode 100644 index 0000000000000..c39fb27d657fc --- /dev/null +++ b/flang/test/Semantics/OpenMP/order-clause02.f90 @@ -0,0 +1,64 @@ +! REQUIRES: openmp_runtime +! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=50 +! OpenMP Version 5.2 +! Various checks for the order clause +! 10.3 `order` Clause + +! Case 1 +subroutine omp_order_runtime_api_call_01() + use omp_lib + integer :: i + !$omp do order(concurrent) + do i = 1, 5 + !ERROR: The OpenMP runtime API calls are not allowed in the `order(concurrent)` clause region + print*, omp_get_thread_num() + end do + !$omp end do +end subroutine omp_order_runtime_api_call_01 + +subroutine omp_order_runtime_api_call_02() + use omp_lib + integer :: i, num_threads + !$omp do order(concurrent) + do i = 1, 5 + !ERROR: The OpenMP runtime API calls are not allowed in the `order(concurrent)` clause region + call omp_set_num_threads(num_threads) + end do + !$omp end do +end subroutine omp_order_runtime_api_call_02 + +! Case 2 +subroutine test_order_threadprivate() + integer :: i, j = 1, x + !$omp threadprivate(j) + !$omp parallel do order(concurrent) + do i = 1, 5 + !ERROR: A THREADPRIVATE variable cannot appear in an `order(concurrent)` clause region, the behavior is unspecified + j = x + 1 + end do + !$omp end parallel do +end subroutine + +! Case 3 +subroutine omp_order_duplicate_01() + implicit none + integer :: i, j + !ERROR: At most one ORDER clause can appear on the TARGET PARALLEL DO SIMD directive + !$OMP target parallel do simd ORDER(concurrent) ORDER(concurrent) + do i = 1, 5 + j = j + 1 + end do + !$omp end target parallel do simd +end subroutine + +subroutine omp_order_duplicate_02() + integer :: i, j + !$omp teams + !ERROR: At most one ORDER clause can appear on the DISTRIBUTE PARALLEL DO SIMD directive + !$omp distribute parallel do simd order(concurrent) order(concurrent) + do i = 1, 5 + j = j + 1 + end do + !$omp end distribute parallel do simd + !$omp end teams +end subroutine diff --git a/llvm/include/llvm/Frontend/OpenMP/OMP.td b/llvm/include/llvm/Frontend/OpenMP/OMP.td index 36834939d9b45..29f6e65f43b38 100644 --- a/llvm/include/llvm/Frontend/OpenMP/OMP.td +++ b/llvm/include/llvm/Frontend/OpenMP/OMP.td @@ -1235,7 +1235,6 @@ def OMP_DistributeParallelDoSimd : Directive<"distribute parallel do simd"> { VersionedClause, VersionedClause, VersionedClause, - VersionedClause, VersionedClause, VersionedClause, VersionedClause, @@ -1244,6 +1243,9 @@ def OMP_DistributeParallelDoSimd : Directive<"distribute parallel do simd"> { VersionedClause, VersionedClause, ]; + let allowedOnceClauses = [ + VersionedClause, + ]; let leafConstructs = [OMP_Distribute, OMP_Parallel, OMP_Do, OMP_Simd]; let category = CA_Executable; } @@ -1908,7 +1910,6 @@ def OMP_TargetParallelDoSimd : Directive<"target parallel do simd"> { VersionedClause, VersionedClause, VersionedClause, - VersionedClause, VersionedClause, VersionedClause, VersionedClause, @@ -1919,6 +1920,9 @@ def OMP_TargetParallelDoSimd : Directive<"target parallel do simd"> { VersionedClause, VersionedClause, ]; + let allowedOnceClauses = [ + VersionedClause + ]; let leafConstructs = [OMP_Target, OMP_Parallel, OMP_Do, OMP_Simd]; let category = CA_Executable; }