From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 19C333857433; Tue, 5 Jul 2022 10:31:59 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 19C333857433 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-12] OpenMP: Fortran - fix ancestor's requires reverse_offload check X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/devel/omp/gcc-12 X-Git-Oldrev: b017548f4d1c028b52943e59e60dcfab01b5ad1d X-Git-Newrev: 6c0936c4c9a91cd56be2fa08a0f9b5f78e05d25e Message-Id: <20220705103159.19C333857433@sourceware.org> Date: Tue, 5 Jul 2022 10:31:59 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 05 Jul 2022 10:31:59 -0000 https://gcc.gnu.org/g:6c0936c4c9a91cd56be2fa08a0f9b5f78e05d25e commit 6c0936c4c9a91cd56be2fa08a0f9b5f78e05d25e Author: Tobias Burnus Date: Tue Jul 5 11:16:43 2022 +0200 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. (cherry picked from commit 5e5deac508e3025e2d2c36212aa52d52001b893d) Diff: --- 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 64529f97336..613ebc121c3 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -2560,8 +2560,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