diff options
| author | Tobias Burnus <tobias@codesourcery.com> | 2022-06-08 10:06:57 +0200 |
|---|---|---|
| committer | Tobias Burnus <tobias@codesourcery.com> | 2022-06-08 10:06:57 +0200 |
| commit | 5e5deac508e3025e2d2c36212aa52d52001b893d (patch) | |
| tree | 931e8a7d31daa0c46d065dcedfac9f41861b444d | |
| parent | ef5cc6bbb60b0ccbc10fb76b697ae02f28af18c0 (diff) | |
| download | gcc-5e5deac508e3025e2d2c36212aa52d52001b893d.zip gcc-5e5deac508e3025e2d2c36212aa52d52001b893d.tar.gz gcc-5e5deac508e3025e2d2c36212aa52d52001b893d.tar.bz2 | |
OpenMP: Fortran - fix ancestor's requires reverse_offload check
gcc/fortran/
* openmp.cc (gfc_match_omp_clauses): Check also parent namespace
for 'requires reverse_offload'.
gcc/testsuite/
* gfortran.dg/gomp/target-device-ancestor-5.f90: New test.
| -rw-r--r-- | gcc/fortran/openmp.cc | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90 | 69 |
2 files changed, 77 insertions, 1 deletions
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index d12cec4..aeb8a43 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -2014,8 +2014,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } else if (gfc_match ("ancestor : ") == MATCH_YES) { + bool has_requires = false; c->ancestor = true; - if (!(gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)) + for (gfc_namespace *ns = gfc_current_ns; ns; ns = ns->parent) + if (ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD) + { + has_requires = true; + break; + } + if (!has_requires) { gfc_error ("%<ancestor%> device modifier not " "preceded by %<requires%> directive " diff --git a/gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90 b/gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90 new file mode 100644 index 0000000..06a11eb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90 @@ -0,0 +1,69 @@ +! { dg-do compile } +! +! Check that a requires directive is still recognized +! if it is in the associated parent namespace of the +! target directive. +! + +module m + !$omp requires reverse_offload ! { dg-error "REQUIRES directive is not yet supported" } +contains + subroutine foo() + !$omp target device(ancestor:1) + !$omp end target + end subroutine foo + + subroutine bar() + block + block + block + !$omp target device(ancestor:1) + !$omp end target + end block + end block + end block + end subroutine bar +end module m + +subroutine foo() + !$omp requires reverse_offload ! { dg-error "REQUIRES directive is not yet supported" } + block + block + block + !$omp target device(ancestor:1) + !$omp end target + end block + end block + end block +contains + subroutine bar() + block + block + block + !$omp target device(ancestor:1) + !$omp end target + end block + end block + end block + end subroutine bar +end subroutine foo + +program main + !$omp requires reverse_offload ! { dg-error "REQUIRES directive is not yet supported" } +contains + subroutine foo() + !$omp target device(ancestor:1) + !$omp end target + end subroutine foo + + subroutine bar() + block + block + block + !$omp target device(ancestor:1) + !$omp end target + end block + end block + end block + end subroutine bar +end |