From patchwork Sat Apr 29 10:57:41 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1775207 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.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+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) 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 ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4Q7mfT6Wgdz23tl for ; Sat, 29 Apr 2023 20:58:08 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1F7E43857354 for ; Sat, 29 Apr 2023 10:58:06 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 829B23858C54; Sat, 29 Apr 2023 10:57:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 829B23858C54 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.99,237,1677571200"; d="scan'208";a="4342716" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa1.mentor.iphmx.com with ESMTP; 29 Apr 2023 02:57:51 -0800 IronPort-SDR: O1SiCdTKkkR2M2qSqc9ctmv7k2cz6Ct/3mZ8DnISvD5o1QHnJG3hdnpfz62GN0pVkEKRmiBWj9 xIEXJJQp7AVr8tR6Bua6C8ZgtLCmXgbBsXc7F76IiXQvwz3nc4nOOZaW3W42qRAmz3ha6e5d2E 1kHkib5bkNaUJD0QlOOfkDEp1KVHB6nm4dESEOeSA1tptkDGYGAxu0Ws7KlilgAKD3gWBYD4v+ bE9vQ8G1j0+t3z/O7oAMhtYYxULbvKEb1RWKvfjSjWP/eTwvv1ZJO7kGCtLTgmQyTsdA9+TCpd boQ= From: Julian Brown To: CC: , , , Subject: [PATCH] OpenACC: Further attach/detach clause fixes for Fortran [PR109622] Date: Sat, 29 Apr 2023 03:57:41 -0700 Message-ID: <20230429105741.108576-1-julian@codesourcery.com> X-Mailer: git-send-email 2.29.2 MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.7 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" This patch moves several tests introduced by the following patch: https://gcc.gnu.org/pipermail/gcc-patches/2023-April/616939.html into the proper location for OpenACC testing (thanks to Thomas for spotting my mistake!), and also fixes a few additional problems -- missing diagnostics for non-pointer attaches, and a case where a pointer was incorrectly dereferenced. Tests are also adjusted for vector-length warnings on nvidia accelerators. Tested with offloading to nvptx. OK? 2023-04-29 Julian Brown PR fortran/109622 gcc/fortran/ * trans-openmp.cc (gfc_trans_omp_clauses): Add diagnostic for non-pointer/non-allocatable attach/detach. Remove dereference for pointer-to-scalar derived type component attach/detach. gcc/testsuite/ * gfortran.dg/goacc/pr109622-5.f90: New test. libgomp/ * testsuite/libgomp.fortran/pr109622.f90: Move test... * testsuite/libgomp.oacc-fortran/pr109622.f90: ...to here. Ignore vector length warning. * testsuite/libgomp.fortran/pr109622-2.f90: Move test... * testsuite/libgomp.oacc-fortran/pr109622-2.f90: ...to here. Add missing copyin/copyout variable. Ignore vector length warnings. * testsuite/libgomp.fortran/pr109622-3.f90: Move test... * testsuite/libgomp.oacc-fortran/pr109622-3.f90: ...to here. Ignore vector length warnings. * testsuite/libgomp.oacc-fortran/pr109622-4.f90: New test. --- gcc/fortran/trans-openmp.cc | 38 ++++++++++++--- .../gfortran.dg/goacc/pr109622-5.f90 | 45 ++++++++++++++++++ .../pr109622-2.f90 | 7 ++- .../pr109622-3.f90 | 3 ++ .../libgomp.oacc-fortran/pr109622-4.f90 | 47 +++++++++++++++++++ .../pr109622.f90 | 3 ++ 6 files changed, 135 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 rename libgomp/testsuite/{libgomp.fortran => libgomp.oacc-fortran}/pr109622-2.f90 (63%) rename libgomp/testsuite/{libgomp.fortran => libgomp.oacc-fortran}/pr109622-3.f90 (76%) create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 rename libgomp/testsuite/{libgomp.fortran => libgomp.oacc-fortran}/pr109622.f90 (78%) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 6ee22faa836a..b9a4ae3e53a8 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -3395,6 +3395,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, && (n->u.map_op == OMP_MAP_ATTACH || n->u.map_op == OMP_MAP_DETACH)) { + OMP_CLAUSE_DECL (node) + = build_fold_addr_expr (OMP_CLAUSE_DECL (node)); OMP_CLAUSE_SIZE (node) = size_zero_node; goto finalize_map_clause; } @@ -3430,6 +3432,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, = TYPE_SIZE_UNIT (gfc_charlen_type_node); } } + else if (openacc + && (n->u.map_op == OMP_MAP_ATTACH + || n->u.map_op == OMP_MAP_DETACH)) + gfc_error ("%qs clause argument not pointer or " + "allocatable at %L", + (n->u.map_op == OMP_MAP_ATTACH) + ? "attach" : "detach", &where); } else if (n->expr && n->expr->expr_type == EXPR_VARIABLE @@ -3510,6 +3519,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } else { + if (openacc + && (n->u.map_op == OMP_MAP_ATTACH + || n->u.map_op == OMP_MAP_DETACH)) + gfc_error ("%qs clause argument not pointer or " + "allocatable at %L", + (n->u.map_op == OMP_MAP_ATTACH) + ? "attach" : "detach", &where); OMP_CLAUSE_DECL (node) = inner; OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (TREE_TYPE (inner)); @@ -3523,15 +3539,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (n->u.map_op == OMP_MAP_ATTACH || n->u.map_op == OMP_MAP_DETACH) { - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + if (POINTER_TYPE_P (TREE_TYPE (inner)) + || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) { - tree ptr = gfc_conv_descriptor_data_get (inner); - OMP_CLAUSE_DECL (node) = ptr; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + { + tree ptr + = gfc_conv_descriptor_data_get (inner); + OMP_CLAUSE_DECL (node) = ptr; + } + else + OMP_CLAUSE_DECL (node) = inner; + OMP_CLAUSE_SIZE (node) = size_zero_node; + goto finalize_map_clause; } else - OMP_CLAUSE_DECL (node) = inner; - OMP_CLAUSE_SIZE (node) = size_zero_node; - goto finalize_map_clause; + gfc_error ("%qs clause argument not pointer or " + "allocatable at %L", + (n->u.map_op == OMP_MAP_ATTACH) + ? "attach" : "detach", &where); } if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) diff --git a/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 b/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 new file mode 100644 index 000000000000..e2748964a1c2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } + +use openacc +implicit none + +type t +integer :: foo +character(len=8) :: bar +integer :: qux(5) +end type t + +type(t) :: var + +var%foo = 3 +var%bar = "HELLOOMP" +var%qux = (/ 1, 2, 3, 4, 5 /) + +!$acc enter data copyin(var) + +!$acc enter data attach(var%foo) +! { dg-error "'attach' clause argument not pointer or allocatable" "" { target *-*-* } .-1 } +!$acc enter data attach(var%bar) +! { dg-error "'attach' clause argument not pointer or allocatable" "" { target *-*-* } .-1 } +!$acc enter data attach(var%qux) +! { dg-error "'attach' clause argument not pointer or allocatable" "" { target *-*-* } .-1 } + +!$acc serial +var%foo = 5 +var%bar = "GOODBYE!" +var%qux = (/ 6, 7, 8, 9, 10 /) +!$acc end serial + +!$acc exit data detach(var%qux) +! { dg-error "'detach' clause argument not pointer or allocatable" "" { target *-*-* } .-1 } +!$acc exit data detach(var%bar) +! { dg-error "'detach' clause argument not pointer or allocatable" "" { target *-*-* } .-1 } +!$acc exit data detach(var%foo) +! { dg-error "'detach' clause argument not pointer or allocatable" "" { target *-*-* } .-1 } + +!$acc exit data copyout(var) + +if (var%foo.ne.5) stop 1 +if (var%bar.ne."GOODBYE!") stop 2 + +end diff --git a/libgomp/testsuite/libgomp.fortran/pr109622-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 similarity index 63% rename from libgomp/testsuite/libgomp.fortran/pr109622-2.f90 rename to libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 index 8c5f373f39f7..d3cbebea6892 100644 --- a/libgomp/testsuite/libgomp.fortran/pr109622-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 @@ -1,5 +1,7 @@ ! { dg-do run } +implicit none + type t integer :: foo integer, pointer :: bar @@ -13,18 +15,19 @@ var%bar => tgt var%foo = 99 tgt = 199 -!$acc enter data copyin(var) +!$acc enter data copyin(var, tgt) !$acc enter data attach(var%bar) !$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } var%foo = 5 var%bar = 7 !$acc end serial !$acc exit data detach(var%bar) -!$acc exit data copyout(var) +!$acc exit data copyout(var, tgt) if (var%foo.ne.5) stop 1 if (tgt.ne.7) stop 2 diff --git a/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 similarity index 76% rename from libgomp/testsuite/libgomp.fortran/pr109622-3.f90 rename to libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 index 3ee1b43a7464..a25b1a814143 100644 --- a/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 @@ -1,5 +1,7 @@ ! { dg-do run } +implicit none + type t integer :: foo integer, pointer :: bar(:) @@ -18,6 +20,7 @@ tgt = 199 !$acc enter data attach(var%bar) !$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } var%foo = 5 var%bar = 7 !$acc end serial diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 new file mode 100644 index 000000000000..3198a0bbf79f --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 @@ -0,0 +1,47 @@ +! { dg-do run } + +use openacc +implicit none + +type t +integer :: foo +character(len=8), pointer :: bar +character(len=4), allocatable :: qux +end type t + +type(t) :: var +character(len=8), target :: tgt + +allocate(var%qux) + +var%bar => tgt + +var%foo = 99 +tgt = "Octopus!" +var%qux = "Fish" + +!$acc enter data copyin(var, tgt) + +! Avoid automatic attach (i.e. with "enter data") +call acc_copyin (var%qux) + +!$acc enter data attach(var%bar, var%qux) + +!$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } +var%foo = 5 +var%bar = "Plankton" +var%qux = "Pond" +!$acc end serial + +!$acc exit data detach(var%bar, var%qux) + +call acc_copyout (var%qux) + +!$acc exit data copyout(var, tgt) + +if (var%foo.ne.5) stop 1 +if (tgt.ne."Plankton") stop 2 +if (var%qux.ne."Pond") stop 3 + +end diff --git a/libgomp/testsuite/libgomp.fortran/pr109622.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 similarity index 78% rename from libgomp/testsuite/libgomp.fortran/pr109622.f90 rename to libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 index 5b8c4102f768..a17c4f627147 100644 --- a/libgomp/testsuite/libgomp.fortran/pr109622.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 @@ -1,5 +1,7 @@ ! { dg-do run } +implicit none + type t integer :: value type(t), pointer :: chain @@ -18,6 +20,7 @@ nullify(var2%chain) !$acc enter data attach(var%chain) !$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } var%value = 5 var%chain%value = 7 !$acc end serial