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. gcc/fortran/openmp.cc | 9 ++- .../gfortran.dg/gomp/target-device-ancestor-5.f90 | 69 ++++++++++++++++++++++ 2 files changed, 77 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index d12cec43d64..aeb8a43e12e 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 ("% device modifier not " "preceded by % 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 00000000000..06a11eb5092 --- /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