From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id C5A5E3858298; Wed, 21 Dec 2022 18:21:32 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C5A5E3858298 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1671646892; bh=pzVABfHz3MqDPHOlJ1Z6joRn/s/2Bax66KiNmcjupvI=; h=From:To:Subject:Date:From; b=NcMgXUgvd1ErQXMyTKyhkGkiBxA0vyMbqUXwCUCQ1liRmwmftVceeGfcWKAiUgbnp Ve94MSBDryXA9swBbxYDVtv28z+dI/8CAQpxeSAOjsZuXwH3OicNv+2szsv97LDBv+ 6PlvCl448yF/8nwy9APpMc3yaaAnWoLg1Tgc7GLI= 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: Combined directives with map/firstprivate of same symbol X-Act-Checkin: gcc X-Git-Author: Julian Brown X-Git-Refname: refs/heads/devel/omp/gcc-12 X-Git-Oldrev: 10aec76c90dc9ba0a8ccf52c8980c61bf684c79a X-Git-Newrev: c4d7c7ee9173323f9db3d84ef7b96894dc2ac664 Message-Id: <20221221182132.C5A5E3858298@sourceware.org> Date: Wed, 21 Dec 2022 18:21:32 +0000 (GMT) List-Id: https://gcc.gnu.org/g:c4d7c7ee9173323f9db3d84ef7b96894dc2ac664 commit c4d7c7ee9173323f9db3d84ef7b96894dc2ac664 Author: Julian Brown Date: Wed Dec 21 18:45:51 2022 +0100 OpenMP/Fortran: Combined directives with map/firstprivate of same symbol This patch fixes a case where a combined directive (e.g. "!$omp target parallel ...") contains both a map and a firstprivate clause for the same variable. When the combined directive is split into two nested directives, the outer "target" gets the "map" clause, and the inner "parallel" gets the "firstprivate" clause, like so: !$omp target parallel map(x) firstprivate(x) --> !$omp target map(x) !$omp parallel firstprivate(x) ... When there is no map of the same variable, the firstprivate is distributed to both directives, e.g. for 'y' in: !$omp target parallel map(x) firstprivate(y) --> !$omp target map(x) firstprivate(y) !$omp parallel firstprivate(y) ... This is not a recent regression, but appear to fix a long-standing ICE. (The included testcase is based on one by Tobias.) 2022-12-06 Julian Brown gcc/fortran/ * trans-openmp.cc (gfc_add_firstprivate_if_unmapped): New function. (gfc_split_omp_clauses): Call above. libgomp/ * testsuite/libgomp.fortran/combined-directive-splitting-1.f90: New test. (cherry picked from commit 9316ad3b4354cbf2980f86902e54884e918c472a) Diff: --- gcc/fortran/ChangeLog.omp | 8 +++++ gcc/fortran/trans-openmp.cc | 37 +++++++++++++++++-- gcc/testsuite/ChangeLog.omp | 8 +++++ .../combined-directive-splitting-1.f90 | 41 ++++++++++++++++++++++ 4 files changed, 92 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 6aec789f641..35de79a99c3 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,11 @@ +2022-12-21 Tobias Burnus + + Backported from master: + 2022-12-14 Julian Brown + + * trans-openmp.cc (gfc_add_firstprivate_if_unmapped): New function. + (gfc_split_omp_clauses): Call above. + 2022-12-12 Tobias Burnus Backported from master: diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 1ac7418495f..22d0fdc04c5 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -7487,6 +7487,39 @@ gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out, } } +/* Kind of opposite to above, add firstprivate to CLAUSES_OUT if it is mapped + in CLAUSES_IN's FIRSTPRIVATE list but not its MAP list. */ + +static void +gfc_add_firstprivate_if_unmapped (gfc_omp_clauses *clauses_out, + gfc_omp_clauses *clauses_in) +{ + gfc_omp_namelist *n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; + gfc_omp_namelist **tail = NULL; + + for (; n != NULL; n = n->next) + { + gfc_omp_namelist *n2 = clauses_out->lists[OMP_LIST_MAP]; + for (; n2 != NULL; n2 = n2->next) + if (n->sym == n2->sym) + break; + if (n2 == NULL) + { + gfc_omp_namelist *dup = gfc_get_omp_namelist (); + *dup = *n; + dup->next = NULL; + if (!tail) + { + tail = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE]; + while (*tail && (*tail)->next) + tail = &(*tail)->next; + } + *tail = dup; + tail = &(*tail)->next; + } + } +} + static void gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa) { @@ -7872,8 +7905,8 @@ gfc_split_omp_clauses (gfc_code *code, simd and masked/master. Put it on the outermost of those and duplicate on parallel and teams. */ if (mask & GFC_OMP_MASK_TARGET) - clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE] - = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + gfc_add_firstprivate_if_unmapped (&clausesa[GFC_OMP_SPLIT_TARGET], + code->ext.omp_clauses); if (mask & GFC_OMP_MASK_TEAMS) clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 4f39e7861a6..40856239d50 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,11 @@ +2022-12-21 Tobias Burnus + + Backported from master: + 2022-12-14 Julian Brown + + * testsuite/libgomp.fortran/combined-directive-splitting-1.f90: New + test. + 2022-12-06 Marcel Vollweiler Backported from master: diff --git a/libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90 b/libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90 new file mode 100644 index 00000000000..e662a2bd3b2 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90 @@ -0,0 +1,41 @@ +module m + integer :: a = 1 + !$omp declare target enter(a) +end module m + +module m2 +contains +subroutine bar() + use m + implicit none + !$omp declare target + a = a + 5 +end subroutine bar +end module m2 + +program p + use m + use m2 + implicit none + integer :: b, i + + !$omp target parallel do map(always, tofrom: a) firstprivate(a) + do i = 1, 1 + a = 7 + call bar() + if (a /= 7) error stop 1 + a = a + 8 + end do + if (a /= 6) error stop 2 + + b = 3 + !$omp target parallel do map(always, tofrom: a) firstprivate(b) + do i = 1, 1 + a = 3 + call bar () + if (a /= 8) error stop 3 + a = a + b + end do + if (a /= 11) error stop 4 +end program p +