diff --git a/flang/docs/OpenMPSupport.md b/flang/docs/OpenMPSupport.md index 5a5285421e724..df29f9626b77a 100644 --- a/flang/docs/OpenMPSupport.md +++ b/flang/docs/OpenMPSupport.md @@ -255,7 +255,7 @@ Parser/Semantics, MLIR, Lowering, or the OpenMPIRBuilder. | loop construct with DO CONCURRENT | in progress | | Experimental support is available and under active development. | [llvm/llvm-project#178138](https://github.com/llvm/llvm-project/pull/178138), [llvm/llvm-project#190990](https://github.com/llvm/llvm-project/pull/190990) | | optional argument for all clauses | partial | | Semantics coverage exists across clause tests (for example `flang/test/Semantics/OpenMP/if-clause-50.f90`). | [llvm/llvm-project#205164](https://github.com/llvm/llvm-project/pull/205164) | | canonical loop sequences | partial | | Related loop/transform coverage exists (`flang/test/Semantics/OpenMP/loop-transformation-construct01.f90`, `flang/test/Lower/OpenMP/loop-directive.f90`). | [llvm/llvm-project#161213](https://github.com/llvm/llvm-project/pull/161213), [llvm/llvm-project#168884](https://github.com/llvm/llvm-project/pull/168884), [llvm/llvm-project#170734](https://github.com/llvm/llvm-project/pull/170734), [llvm/llvm-project#170735](https://github.com/llvm/llvm-project/pull/170735) | -| pure directives in DO CONCURRENT | unclaimed | | Define exact PURE+DO CONCURRENT directive legality in semantics and add lowering tests proving accepted forms remain side-effect safe. | | +| pure directives in DO CONCURRENT | done | | Semantics enforce that OpenMP directives inside a DO CONCURRENT body must have the "pure" property. | [llvm/llvm-project#216642](https://github.com/llvm/llvm-project/pull/216642) | | pure procedure support extended to more directives | done | | Semantics extend the OpenMP 5.2 pure-procedure allow list with the newly added loop-transforming constructs and the scan directive. | [llvm/llvm-project#212676](https://github.com/llvm/llvm-project/pull/212676) | | extensions to depobj construct | unclaimed | | Semantics and deprecation diagnostics exist for several depobj forms, but extension support remains incomplete in lowering (for example `flang/test/Lower/OpenMP/Todo/depobj-construct.f90`). Implement lowering for extension operands/modifiers and add non-TODO lowering tests. | | | extensions to atomic construct | partial | | Atomic compare lowering is now available (`flang/test/Lower/OpenMP/atomic-compare.f90`), but fail/capture-related extension paths remain incomplete (`flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90`). | [llvm/llvm-project#184761](https://github.com/llvm/llvm-project/pull/184761) | diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h index eab005c2a08ac..54efd784c7804 100644 --- a/flang/include/flang/Semantics/openmp-utils.h +++ b/flang/include/flang/Semantics/openmp-utils.h @@ -296,6 +296,8 @@ struct OmpErrorArgs { /// Scan the clause list of an `!$omp error` directive for its AT, SEVERITY, and /// MESSAGE clause values. +OmpErrorArgs GetErrorDirectiveArgs( + const parser::OmpDirectiveSpecification &spec); OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir); inline bool IsDoConcurrentLegal(llvm::omp::Version version) { diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 6f9caeea9de2b..e625ef53ef4a5 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -958,28 +958,66 @@ void OmpStructureChecker::CheckDirectiveDeprecation( // one another, but only the top-level directive should cause a warning. } -void OmpStructureChecker::CheckDirectiveInPureProcedure( - parser::CharBlock source, llvm::omp::Directive id) { - const Scope &scope{context_.FindScope(source)}; - if (!FindPureProcedureContaining(scope)) { - return; - } +void OmpStructureChecker::CheckDirectivePureSince(parser::CharBlock source, + llvm::omp::Directive id, const char *where, + const parser::OmpDirectiveSpecification &spec) { llvm::omp::Version version{context_.langOptions().getOpenMPVersion()}; // A directive's "pure" property is version-specific: pureSince is the // OpenMP version at which the directive gained that property. llvm::omp::Version pureSince{llvm::omp::getDirectivePureSince(id)}; + if (id == llvm::omp::Directive::OMPD_error && + GetErrorDirectiveArgs(spec).at != + parser::OmpAtClause::ActionTime::Compilation) { + // ERROR is only "pure" when its action-time is compilation. + pureSince = llvm::omp::Version{0x7FFFFFFF}; + } if (version >= pureSince) { return; } if (pureSince != 0x7FFFFFFF) { context_.Say(source, - "The OpenMP directive '%s' is not allowed in a PURE procedure in %s, %s"_err_en_US, - parser::omp::GetUpperName(id, version), ThisVersion(version), + "The OpenMP directive '%s' is not allowed in %s in %s, %s"_err_en_US, + parser::omp::GetUpperName(id, version), where, ThisVersion(version), TryVersion(pureSince)); } else { context_.Say(source, - "The OpenMP directive '%s' is not allowed in a PURE procedure"_err_en_US, - parser::omp::GetUpperName(id, version)); + "The OpenMP directive '%s' is not allowed in %s"_err_en_US, + parser::omp::GetUpperName(id, version), where); + } +} + +void OmpStructureChecker::CheckDirectiveInPureProcedure( + parser::CharBlock source, llvm::omp::Directive id, + const parser::OmpDirectiveSpecification &spec) { + const Scope &scope{context_.FindScope(source)}; + if (!FindPureProcedureContaining(scope)) { + return; + } + CheckDirectivePureSince(source, id, "a PURE procedure", spec); +} + +void OmpStructureChecker::CheckDirectiveInDoConcurrent(parser::CharBlock source, + llvm::omp::Directive id, const parser::OmpDirectiveSpecification &spec) { + // Look for any enclosing DO CONCURRENT, not just the nearest DO, since a + // plain DO nested inside DO CONCURRENT is still part of its body. + for (const LoopOrConstruct &c : llvm::reverse(constructStack_)) { + auto *doConstruct{std::get_if(&c)}; + if (!doConstruct || !(*doConstruct)->IsDoConcurrent()) { + continue; + } + llvm::omp::Version version{context_.langOptions().getOpenMPVersion()}; + if (!IsDoConcurrentLegal(version)) { + // Prior to OpenMP 6.0, no OpenMP directive, regardless of its "pure" + // property, was allowed inside a DO CONCURRENT construct. + context_.Say(source, + "The OpenMP directive '%s' is not allowed in a DO CONCURRENT construct"_err_en_US, + parser::omp::GetUpperName(id, version)); + } else { + // Starting with OpenMP 6.0, directives that have the "pure" property + // are permitted inside a DO CONCURRENT construct. + CheckDirectivePureSince(source, id, "a DO CONCURRENT construct", spec); + } + return; } } @@ -1331,7 +1369,8 @@ void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) { PushContextAndClauseSets(dirName.source, dirName.v); dirStack_.push_back(&GetOmpDirectiveSpecification(x)); CheckDirectiveDeprecation(x); - CheckDirectiveInPureProcedure(dirName.source, dirName.v); + CheckDirectiveInPureProcedure(dirName.source, dirName.v, *dirStack_.back()); + CheckDirectiveInDoConcurrent(dirName.source, dirName.v, *dirStack_.back()); // Verify clauses common::visit( @@ -1388,7 +1427,8 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) { CheckClauses(dirName, llvm::iterator_range(dirStack_.back()->Clauses().v), llvm::iterator_range(std::list{})); - CheckDirectiveInPureProcedure(dirName.source, dirName.v); + CheckDirectiveInPureProcedure(dirName.source, dirName.v, *dirStack_.back()); + CheckDirectiveInDoConcurrent(dirName.source, dirName.v, *dirStack_.back()); EnterDirectiveNest(DeclarativeNest); } diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 8016c82b8496f..c3f491fde0dac 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -348,8 +348,13 @@ class OmpStructureChecker : public OmpStructureCheckerBase { void CheckDirectiveSpelling( parser::CharBlock spelling, llvm::omp::Directive id); void CheckDirectiveDeprecation(const parser::OpenMPConstruct &x); - void CheckDirectiveInPureProcedure( - parser::CharBlock source, llvm::omp::Directive id); + void CheckDirectivePureSince(parser::CharBlock source, + llvm::omp::Directive id, const char *where, + const parser::OmpDirectiveSpecification &spec); + void CheckDirectiveInPureProcedure(parser::CharBlock source, + llvm::omp::Directive id, const parser::OmpDirectiveSpecification &spec); + void CheckDirectiveInDoConcurrent(parser::CharBlock source, + llvm::omp::Directive id, const parser::OmpDirectiveSpecification &spec); void CheckClauses(parser::OmpDirectiveName dirName, llvm::iterator_range beginClauses, llvm::iterator_range endClauses); diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp index 2e747408cec87..5704e72c4697c 100644 --- a/flang/lib/Semantics/check-omp-variant.cpp +++ b/flang/lib/Semantics/check-omp-variant.cpp @@ -744,6 +744,22 @@ void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) { if (dirId != llvm::omp::Directive::OMPD_metadirective) { metadirectiveLoopVariants_.push_back( {currentWhenSelector_, &x, checkDefaultNoneInAssociatedLoop}); + // Metadirective is "pure", but its selected variant may not be. + // Check the variant independently only when metadirective is legal; + // otherwise, the outer metadirective check already reports the error. + if (GetDirectiveNest(MetadirectiveNest)) { + llvm::omp::Version version{context_.langOptions().getOpenMPVersion()}; + if (version >= llvm::omp::getDirectivePureSince( + llvm::omp::Directive::OMPD_metadirective)) { + CheckDirectiveInPureProcedure(x.DirName().source, dirId, x); + } + if (IsDoConcurrentLegal(version)) { + CheckDirectiveInDoConcurrent(x.DirName().source, dirId, x); + } + } else { + CheckDirectiveInPureProcedure(x.DirName().source, dirId, x); + CheckDirectiveInDoConcurrent(x.DirName().source, dirId, x); + } } } diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index a19bde31643d8..37c3713c38629 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -921,9 +921,10 @@ bool IsFullUnroll(const parser::OmpDirectiveSpecification &spec) { return false; } -OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) { +OmpErrorArgs GetErrorDirectiveArgs( + const parser::OmpDirectiveSpecification &spec) { OmpErrorArgs args; - for (const parser::OmpClause &clause : errDir.v.Clauses().v) { + for (const parser::OmpClause &clause : spec.Clauses().v) { if (const auto *at{std::get_if(&clause.u)}) { args.at = at->v.v; } else if (const auto *sev{ @@ -937,6 +938,10 @@ OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) { return args; } +OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) { + return GetErrorDirectiveArgs(errDir.v); +} + static bool IsTransformableLoop(const parser::OmpDirectiveSpecification &spec) { return !IsFullUnroll(spec) && IsLoopTransforming(spec.DirId()); } diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90 new file mode 100644 index 0000000000000..b4a85e61f2f64 --- /dev/null +++ b/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90 @@ -0,0 +1,22 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=52 + +! Prior to OpenMP 6.0, no OpenMP directive is allowed inside a DO CONCURRENT +! construct, regardless of whether it would otherwise have the "pure" +! property (e.g. SIMD, which has been "pure" since OpenMP 4.5). + +module m +contains + subroutine do_concurrent_bad(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i, j + do concurrent (i = 1:n) + !ERROR: The OpenMP directive 'SIMD' is not allowed in a DO CONCURRENT construct + !$omp simd + do j = 1, n + end do + !ERROR: The OpenMP directive 'BARRIER' is not allowed in a DO CONCURRENT construct + !$omp barrier + end do + end subroutine +end module diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 new file mode 100644 index 0000000000000..0e694995e85ad --- /dev/null +++ b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 @@ -0,0 +1,175 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=60 + +! Starting with OpenMP 6.0, directives with the "pure" property are allowed +! in a DO CONCURRENT construct; other directives are still rejected. + +module m +contains + subroutine do_concurrent_valid(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i, j + do concurrent (i = 1:n) + !$omp nothing + !$omp simd + do j = 1, n + a(i) = a(i) + 1 + end do + end do + end subroutine + + ! A DO CONCURRENT nested in another DO CONCURRENT is checked against its + ! innermost enclosing DO CONCURRENT. + subroutine do_concurrent_nested_do_concurrent(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n, n) + integer :: i, j, k + do concurrent (i = 1:n) + do concurrent (j = 1:n) + !$omp simd + do k = 1, n + a(i, j) = a(i, j) + 1 + end do + !ERROR: The OpenMP directive 'PARALLEL' is not allowed in a DO CONCURRENT construct + !$omp parallel + !$omp end parallel + end do + end do + end subroutine + + ! A BLOCK construct nested in DO CONCURRENT is still part of its body. + subroutine do_concurrent_nested_block(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + block + !$omp nothing + !ERROR: The OpenMP directive 'CRITICAL' is not allowed in a DO CONCURRENT construct + !$omp critical + a(i) = a(i) + 1 + !$omp end critical + end block + end do + end subroutine + + ! A METADIRECTIVE only reflects its own "pure" property; whichever variant + ! it selects must be checked independently. + subroutine do_concurrent_metadirective(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + !$omp metadirective when(user={condition(.true.)}: nothing) + !$omp metadirective when(user={condition(.false.)}: nothing) otherwise(assume no_openmp) + a(i) = a(i) + 1 + end do + end subroutine + + subroutine do_concurrent_metadirective_bad(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + !ERROR: The OpenMP directive 'PARALLEL' is not allowed in a DO CONCURRENT construct + !$omp metadirective when(user={condition(.true.)}: parallel) + block + end block + end do + end subroutine + + ! An `!$omp error` directive is only "pure" when its action-time is + ! compilation; AT(EXECUTION) defers the mandated abort to run time, so it + ! is never allowed in a DO CONCURRENT construct. + subroutine do_concurrent_error_at_compilation(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + !WARNING: ok + !$omp error at(compilation) severity(warning) message("ok") + a(i) = a(i) + 1 + end do + end subroutine + + subroutine do_concurrent_error_at_execution(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + !ERROR: The OpenMP directive 'ERROR' is not allowed in a DO CONCURRENT construct + !$omp error at(execution) severity(fatal) message("boom") + a(i) = a(i) + 1 + end do + end subroutine + + ! The same AT(EXECUTION) restriction applies to a METADIRECTIVE's variant. + subroutine do_concurrent_metadirective_error_at_execution(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + !ERROR: The OpenMP directive 'ERROR' is not allowed in a DO CONCURRENT construct + !$omp metadirective when(user={condition(.true.)}: error at(execution) severity(fatal) message("boom")) + a(i) = a(i) + 1 + end do + end subroutine + + ! An APPLY clause's directive-variant must be pure too, independently of + ! its host directive (TILE, which is itself pure). + subroutine do_concurrent_apply(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n, n) + integer :: i, j + do concurrent (i = 1:n) + !$omp tile sizes(2) apply(grid: nothing) + do j = 1, n + a(i, j) = a(i, j) + 1 + end do + end do + end subroutine + + subroutine do_concurrent_apply_bad(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n, n) + integer :: i, j + do concurrent (i = 1:n) + !ERROR: The OpenMP directive 'BARRIER' is not allowed in a DO CONCURRENT construct + !$omp tile sizes(2) apply(grid: barrier) + do j = 1, n + a(i, j) = a(i, j) + 1 + end do + end do + end subroutine + + subroutine do_concurrent_bad(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i + do concurrent (i = 1:n) + !ERROR: The OpenMP directive 'BARRIER' is not allowed in a DO CONCURRENT construct + !$omp barrier + !ERROR: The OpenMP directive 'PARALLEL' is not allowed in a DO CONCURRENT construct + !$omp parallel + !$omp end parallel + !ERROR: The OpenMP directive 'ATOMIC' is not allowed in a DO CONCURRENT construct + !$omp atomic + a(i) = a(i) + 1 + end do + end subroutine + + ! A plain DO nested in DO CONCURRENT is still part of its body. + subroutine do_concurrent_nested_do(a, n) + integer, intent(in) :: n + integer, intent(inout) :: a(n) + integer :: i, j + do concurrent (i = 1:n) + do j = 1, n + !ERROR: The OpenMP directive 'TASK' is not allowed in a DO CONCURRENT construct + !$omp task + !$omp end task + end do + a(i) = a(i) + 1 + end do + end subroutine +end module diff --git a/flang/test/Semantics/OpenMP/pure-procedure.f90 b/flang/test/Semantics/OpenMP/pure-procedure.f90 index d942d1b193b8e..4c018559b3181 100644 --- a/flang/test/Semantics/OpenMP/pure-procedure.f90 +++ b/flang/test/Semantics/OpenMP/pure-procedure.f90 @@ -18,7 +18,8 @@ pure subroutine pure_ok(a, n) !$omp assume no_openmp !$omp end assume !$omp metadirective when(user={condition(.true.)}: nothing) - !$omp error at(execution) severity(warning) message("ok") + !WARNING: ok + !$omp error at(compilation) severity(warning) message("ok") !$omp tile sizes(4) do i = 1, n a(i) = a(i) + 1 @@ -95,5 +96,8 @@ pure subroutine pure_bad(a, n, r) !ERROR: The OpenMP directive 'TASK' is not allowed in a PURE procedure !$omp task !$omp end task + ! ERROR is only pure when its action-time is compilation. + !ERROR: The OpenMP directive 'ERROR' is not allowed in a PURE procedure + !$omp error at(execution) severity(warning) message("bad") end subroutine end module