From patchwork Thu Jul 23 15:06:31 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1334949 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4BCFzk3xmxz9sPf for ; Fri, 24 Jul 2020 01:06:58 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1AAEE387548D; Thu, 23 Jul 2020 15:06:53 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 4ED983857C5A; Thu, 23 Jul 2020 15:06:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 4ED983857C5A Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: jrZn/SUF6xiFnbXqBSNexvSwjIILDqe9yqU3wfTtxLlxyWAkX2WUGjb2Sd4sSObnlLJ0QOH29b Nrf+yHXEufmhX2pqD9L6FmcAkv59g9xFK9wtHqoMKWlhP0dA99s/RlsrB4WYuydG5dRkPG4psB spLQqVfzfy1NFmUs1+Iqpym8uZ1dN7un4vvP1dyROtq4JyFpHrVOwPJREWEksHuudJ9i6exQY/ WDdldj1pTD/pf1gyJ4/+q3wkZ1U4FzYpejJeJysvBQar7nWfaCCLP6qCpft7psMfHUa4kK6pn8 Hjg= X-IronPort-AV: E=Sophos;i="5.75,386,1589270400"; d="diff'?scan'208";a="51347753" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 23 Jul 2020 07:06:43 -0800 IronPort-SDR: VAQjMBZfJoLxZY6Lv1WsmKMjyh2r27YuXcBszqJVOVmx6CzgvblhfmLVcAw4M78pfquGHefmwA aaBnSUUNWbpmP0AIeTHJl6xVSNyXzqDIMjuIXOJh40dP9MyQ2XlOgAsVe7YKmPOlsXJhsbqIxY 2kVxjHEBnMyBgYQpA139gqUEFy20dNkN1cAnkaG0i7G1wSzE2yZQjIAUAOhLZE2x748ujo/HBp MeBkIKP6ObIgO61r6XhTW/1HNTs3nFGH5NdppsC/ZZwQmQebO+x7r8m5aI8aoOsFduNjke0aNh 8hE= From: Tobias Burnus Subject: [Patch] OpenMP: Support 'lastprivate (conditional:' in Fortran To: gcc-patches , Jakub Jelinek , fortran Message-ID: Date: Thu, 23 Jul 2020 17:06:31 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.10.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-13.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Another simple-to-add feature as the main work was done in the middle-end for C/C++. (I do note that 'master taskloop [simd]' is not yet supported in gfortran.) OK? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter OpenMP: Support 'lastprivate (conditional:' in Fortran gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_namelist): Add lastprivate_conditional. * openmp.c (gfc_match_omp_clauses): Handle 'conditional:' modifier of 'lastprivate'. * trans-openmp.c (gfc_omp_clause_default_ctor): Don't assert on OMP_CLAUSE__CONDTEMP_ and other OMP_*TEMP_. (gfc_trans_omp_variable_list): Handle lastprivate_conditional. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/lastprivate-conditional-1.f90: New test. * gfortran.dg/gomp/lastprivate-conditional-2.f90: New test. * gfortran.dg/gomp/lastprivate-conditional-3.f90: New test. * gfortran.dg/gomp/lastprivate-conditional-4.f90: New test. * gfortran.dg/gomp/lastprivate-conditional-5.f90: New test. gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 20 ++++-- gcc/fortran/trans-openmp.c | 23 ++++-- .../gfortran.dg/gomp/lastprivate-conditional-1.f90 | 82 ++++++++++++++++++++++ .../gfortran.dg/gomp/lastprivate-conditional-2.f90 | 46 ++++++++++++ .../gfortran.dg/gomp/lastprivate-conditional-3.f90 | 65 +++++++++++++++++ .../gfortran.dg/gomp/lastprivate-conditional-4.f90 | 28 ++++++++ .../gfortran.dg/gomp/lastprivate-conditional-5.f90 | 47 +++++++++++++ 8 files changed, 304 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1648831736c..5fa86aa4e30 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1242,6 +1242,7 @@ typedef struct gfc_omp_namelist gfc_omp_map_op map_op; gfc_omp_linear_op linear_op; struct gfc_common_head *common; + bool lastprivate_conditional; } u; struct gfc_omp_namelist_udr *udr; struct gfc_omp_namelist *next; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index e89ae295a31..f8f2439b6e4 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1355,10 +1355,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'l': if ((mask & OMP_CLAUSE_LASTPRIVATE) - && gfc_match_omp_variable_list ("lastprivate (", - &c->lists[OMP_LIST_LASTPRIVATE], - true) == MATCH_YES) - continue; + && gfc_match ("lastprivate ( ") == MATCH_YES) + { + bool conditional = gfc_match ("conditional : ") == MATCH_YES; + head = NULL; + if (gfc_match_omp_variable_list ("", + &c->lists[OMP_LIST_LASTPRIVATE], + false, NULL, &head) == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.lastprivate_conditional = conditional; + continue; + } + gfc_current_locus = old_loc; + break; + } end_colon = false; head = NULL; if ((mask & OMP_CLAUSE_LINEAR) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 56bc7cd10cc..d12d7fbddac 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -613,10 +613,21 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b; stmtblock_t block, cond_block; - gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE - || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE - || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR - || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION); + switch (OMP_CLAUSE_CODE (clause)) + { + case OMP_CLAUSE__LOOPTEMP_: + case OMP_CLAUSE__REDUCTEMP_: + case OMP_CLAUSE__CONDTEMP_: + case OMP_CLAUSE__SCANTEMP_: + return NULL; + case OMP_CLAUSE_PRIVATE: + case OMP_CLAUSE_LASTPRIVATE: + case OMP_CLAUSE_LINEAR: + case OMP_CLAUSE_REDUCTION: + break; + default: + gcc_unreachable (); + } if ((! GFC_DESCRIPTOR_TYPE_P (type) || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) @@ -1678,6 +1689,10 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, tree node = build_omp_clause (input_location, code); OMP_CLAUSE_DECL (node) = t; list = gfc_trans_add_clause (node, list); + + if (code == OMP_CLAUSE_LASTPRIVATE + && namelist->u.lastprivate_conditional) + OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (node) = 1; } } return list; diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90 new file mode 100644 index 00000000000..7a024061ec6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90 @@ -0,0 +1,82 @@ +subroutine foo (p) + implicit none + logical :: p(:) + integer a, b, c, d, e, f, g, h; + integer :: i + a = -1; b = -1; c = -1; d = -1; e = -1; f = -1; g = -1; h = -1 + !$omp teams + !$omp distribute lastprivate (conditional: a) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" } + do i = 1, 32 + if (p(i)) & + a = i + end do + !$omp distribute simd lastprivate (conditional: b) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" } + do i = 1, 32 + if (p(i)) & + b = i + end do + !$omp distribute parallel do lastprivate (conditional: c) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" } + do i = 1, 32 + if (p(i)) & + c = i + end do + !$omp distribute parallel do simd lastprivate (conditional: d) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" } + do i = 1, 32 + if (p(i)) & + d = i + end do + !$omp end teams + + !$omp teams distribute parallel do lastprivate (conditional: e) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" } + do i = 1, 32 + if (p(i)) & + e = i + end do + + !$omp parallel + !$omp master + !$omp taskloop lastprivate (conditional: f) ! { dg-error "conditional 'lastprivate' clause on 'taskloop' construct" } + do i = 1, 32 + if (p(i)) & + f = i + end do +! !$omp master taskloop simd lastprivate (conditional: g) ! { dg!error "conditional 'lastprivate' clause on 'taskloop' construct" } +! do i = 1, 32 +! if (p(i)) & +! g = i +! end do + !$omp end master + !$omp end parallel + +! !$omp parallel master taskloop simd lastprivate (conditional: h) ! { dg!error "conditional 'lastprivate' clause on 'taskloop' construct" } +! do i = 1, 32 +! if (p(i)) & +! h = i +! end do +! !$omp end parallel master taskloop simd +end subroutine + +!struct S { int a, b; }; + +subroutine bar (p) + implicit none + logical :: p(:) + type s_t + integer :: a, b + end type s_t + type(s_t) s, t + integer i + s = s_t(-1, -1) + t = s_t( 1, 2) + !$omp parallel do lastprivate (conditional: s) ! { dg-error "non-scalar variable 's' in conditional 'lastprivate' clause" } + do i = 1, 32 + if (p(i)) then + block + type(s_t) u + u = t + u%b = i + s = u + end block + end if + end do +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90 new file mode 100644 index 00000000000..5c95d8f77d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90 @@ -0,0 +1,46 @@ +! { dg-additional-options "-fdump-tree-original" } +subroutine foo (p) + logical :: p(:) + integer i + integer a, b, c, d, e, f, g, h + a = -1; b = -1; c = -1; d = -1; e = -1; f = -1; g = -1; h = -1 + !$omp parallel + !$omp do lastprivate (conditional: a) + do i = 1, 32 + if (p(i)) & + a = i + end do + !$omp end parallel + !$omp simd lastprivate (conditional: b) + do i = 1, 32 + if (p(i)) & + b = i + end do + !$omp parallel + !$omp do simd lastprivate (conditional: c) + do i = 1, 32 + if (p(i)) & + c = i + end do + !$omp end parallel + !$omp parallel do lastprivate (conditional: d) + do i = 1, 32 + if (p(i)) & + d = i + end do + !$omp end parallel do + !$omp parallel do simd lastprivate (conditional: e) + do i = 1, 32 + if (p(i)) & + e = i + end do + !$omp end parallel do simd +end subroutine + +! { dg-final { scan-tree-dump-times "#pragma omp for lastprivate\\(conditional:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:b\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp for lastprivate\\(conditional:c\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:c\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(conditional:d\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(conditional:e\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:e\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90 new file mode 100644 index 00000000000..720fe9b64a8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90 @@ -0,0 +1,65 @@ +subroutine foo + integer i, j, k + !$omp parallel + !$omp do lastprivate (conditional: i) ! { dg-warning "conditional 'lastprivate' on loop iterator 'i' ignored" } + do i = 1, 32 + end do + !$omp do collapse (3) lastprivate (conditional: i) ! { dg-warning "conditional 'lastprivate' on loop iterator 'i' ignored" } + do i = 1, 32 + do j = 1, 32 + do k = 1, 32 + end do + end do + end do + !$omp do collapse (3) lastprivate (conditional: j) ! { dg-warning "conditional 'lastprivate' on loop iterator 'j' ignored" } + do i = 1, 32 + do j = 1, 32 + do k = 1, 32 + end do + end do + end do + !$omp do collapse (3) lastprivate (conditional: k) ! { dg-warning "conditional 'lastprivate' on loop iterator 'k' ignored" } + do i = 1, 32 + do j = 1, 32 + do k = 1, 32 + end do + end do + end do + !$omp end parallel + + ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'i' ignored" + !$omp parallel do lastprivate (conditional: i) + do i = 1, 32 + end do + !$omp end parallel do + + ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'i' ignored" + !$omp parallel do collapse (3) lastprivate (conditional: i) + do i = 1, 32 + do j = 1, 32 + do k = 1, 32 + end do + end do + end do + !$omp end parallel do + + ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'j' ignored" + !$omp parallel do collapse (3) lastprivate (conditional: j) + do i = 1, 32 + do j = 1, 32 + do k = 1, 32 + end do + end do + end do + !$omp end parallel do + + ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'k' ignored" + !$omp parallel do collapse (3) lastprivate (conditional: k) + do i = 1, 32 + do j = 1, 32 + do k = 1, 32 + end do + end do + end do + !$omp end parallel do +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90 new file mode 100644 index 00000000000..1e8c6c7e41a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90 @@ -0,0 +1,28 @@ +module m +integer x, w +end module m + +subroutine foo + use m + interface + logical function bar(i) + integer i + end function + end interface + integer y, i, z + logical tmp + y = 5 + !$omp teams num_teams(1) firstprivate (x) shared (y) shared (w) + !$omp parallel do firstprivate (x, y, z, w) lastprivate (conditional: x, y, z, w) + do i = 1, 64 + if (bar (i)) then + x = i; + y = i + 1; + z = i + 2; + w = i + 3; + end if + tmp = bar (y); + tmp = bar (z); + end do + !$omp end teams +end diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90 new file mode 100644 index 00000000000..e2f3cb7dd90 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90 @@ -0,0 +1,47 @@ +! { dg-do compile } +! { dg-options "-O2 -fopenmp -fdump-tree-ompexp" } +! { dg-final { scan-tree-dump-times "GOMP_loop_start " 3 "ompexp" } } +! { dg-final { scan-tree-dump-times "GOMP_loop_end_nowait " 3 "ompexp" } } + +module m + logical r +end module m + +subroutine foo (a) + use m + implicit none + logical a(:) + integer :: i + !$omp do lastprivate(conditional: r) + do i = 1, 64 + if (a(i)) & + r = a(i) + end do + !$omp end do nowait +end + +subroutine bar (a) + use m + implicit none + logical a(:) + integer :: i + !$omp do lastprivate(conditional: r) schedule (static, 4) + do i = 1, 64 + if (a(i)) & + r = a(i) + end do + !$omp end do nowait +end + +subroutine baz (a) + use m + implicit none + logical a(:) + integer :: i + !$omp do lastprivate(conditional: r) schedule (runtime) + do i = 1, 64 + if (a(i)) & + r = a(i) + end do + !$omp end do nowait +end