From patchwork Fri Oct 4 14:59:13 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Kwok Cheung Yeung X-Patchwork-Id: 1992783 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=baylibre-com.20230601.gappssmtp.com header.i=@baylibre-com.20230601.gappssmtp.com header.a=rsa-sha256 header.s=20230601 header.b=aH5ax+px; dkim-atps=neutral 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=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.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 (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4XKsDH4Qcwz1xtH for ; Sat, 5 Oct 2024 01:00:31 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D453B38425B9 for ; Fri, 4 Oct 2024 15:00:28 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x234.google.com (mail-lj1-x234.google.com [IPv6:2a00:1450:4864:20::234]) by sourceware.org (Postfix) with ESMTPS id 974A8386F473 for ; Fri, 4 Oct 2024 14:59:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 974A8386F473 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=baylibre.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=baylibre.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 974A8386F473 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::234 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1728053984; cv=none; b=nRO1raIw9eSA7MjWOl7DasUvILerKbLNilkxbtaBJ8627cPbPpZ9jMEn/Jy7Kti3eH4tGRhjCye+bmFLT54K+i0fy2NGQaUjkZI/TcKFBJvvbbFVpGep0DT1ySCxpuFr28L8q7G0kQ/c3AbBh7E0b6ZKM/LGyDPHo6l4e2SD1ks= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1728053984; c=relaxed/simple; bh=KIpe9HUSgyQS7JQ1B29lgzm/XFiCh6/q/vbDpQ9oOuY=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:Subject:From; b=apGk7JRPkFsa+WQQ3O06VWdyKaRq92Dc0XC9QV47HZFS77hd1xPvoeD49ydD/E415+z8s/t4dd8F4rEKm2XSdOnCGAT5KwAa+NUmtR61DtC57/WfBCITFemJM/B9q2V8XXBvcqgn2aBac/lMWqb4n+0bAGclgA1HshQer/AwCzg= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lj1-x234.google.com with SMTP id 38308e7fff4ca-2f75c56f16aso24114771fa.0 for ; Fri, 04 Oct 2024 07:59:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=baylibre-com.20230601.gappssmtp.com; s=20230601; t=1728053980; x=1728658780; darn=gcc.gnu.org; h=in-reply-to:from:content-language:subject:references:to:user-agent :mime-version:date:message-id:from:to:cc:subject:date:message-id :reply-to; bh=S/fLFKnnfk5FjznT0yuhRNrBrzI3f7gFs94r85zNedU=; b=aH5ax+pxrPN0pr7fj2B/OsXGrRkMDG20ofjCdtn4YtyfDTnBuqKh9fxOgMNzy4Wcjg 3TsaAx/DPi9u1cvlD1Gg9OA6N57dj/MKUH5sdnADCHwpbce2cPssZFQpe/raBR5I1xeQ vVCCd58wPuROnfavnQjy/6nxo1iAtkSjHag1UFqpr2I0Cc2iquRFntEEDVmzC/c34Fh4 jAlojeF0rEf6bcaMU/sOfFHj9eIu8ongI/145jbTw+cYwdvXxPirAZCJkjzsJ0D0x7xk O/wccLe6PmfZqWhWBWz466FhzRuXyStTTb6PKrKxCTs1+gqUTVmPckUj+uSnNYu3A4Cu TQkw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1728053980; x=1728658780; h=in-reply-to:from:content-language:subject:references:to:user-agent :mime-version:date:message-id:x-gm-message-state:from:to:cc:subject :date:message-id:reply-to; bh=S/fLFKnnfk5FjznT0yuhRNrBrzI3f7gFs94r85zNedU=; b=TbzR30Vo4AQqQCnECseWhBMdh3XWmGjApHb34PrXvjeYx+rH6vsTAbcTBLRPFyyfVl fSrNeHw7eDLFaJCOIy4TNhBAWaQ5f35G6rYbfugRsJfBGrYfUAs3uaFDgEYppmsffpIp ltDmavd/x0OFIq8MToRiAq+yIMNhJP3p3gKEUM26txwnVDJytgKQ3lz4tuNNKsKlP0w4 7mU1H9T9/tzRqB19tYj5M/XGgE2iemzqR9F99hkgEDxOpHp2tlPxEJlPHIoeujZ0KEwI LbqhcN6HyTtPEZtyTJiGKxzhx2aZl9rkL18nW3F/rfWPcqDJqOkxlSLTZ8U0vQDgUNWt g7eg== X-Gm-Message-State: AOJu0YyIrQPZsaskFCbu75Pa3J6Rg9nYJpgKEl1Qk2nh0qLLUqu3c8yO xdNsVV27Np78vfm0iPrcmM7S6aW1lFP3YMEy+VhKr+qNanpE6jNVTP2iOPB7u9RYXrO0JkHcDG1 0 X-Google-Smtp-Source: AGHT+IFaO0lCZSsc0o+EZ5sAQ/EhdyCPC3mWMNwS+k2+gafFU0ptzPiPHBLxnW6SI2pV3UhIeKsMiA== X-Received: by 2002:a05:6512:3b85:b0:536:54df:bffc with SMTP id 2adb3069b0e04-539ab9dc722mr1687814e87.42.1728053979738; Fri, 04 Oct 2024 07:59:39 -0700 (PDT) Received: from ?IPV6:2a00:23c6:88fe:9301:2d7d:f734:bc6:c47b? ([2a00:23c6:88fe:9301:2d7d:f734:bc6:c47b]) by smtp.gmail.com with ESMTPSA id a640c23a62f3a-a992e5d0b41sm2280966b.9.2024.10.04.07.59.39 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 04 Oct 2024 07:59:39 -0700 (PDT) Message-ID: Date: Fri, 4 Oct 2024 15:59:13 +0100 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird To: gcc-patches , fortran@gcc.gnu.org, Jakub Jelinek , Tobias Burnus References: <6b94b8ed-020b-47e2-b02a-4891891f2847@baylibre.com> Subject: [PATCH v3 5/5] openmp, fortran: Add support for iterators in OpenMP 'target update' constructs (Fortran) Content-Language: en-GB From: Kwok Cheung Yeung In-Reply-To: <6b94b8ed-020b-47e2-b02a-4891891f2847@baylibre.com> X-Spam-Status: No, score=-13.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.30 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 This patch adds parsing and translation of the 'to' and 'from' clauses for the 'target update' construct in Fortran. From da8ab0cb38d2bc347cf902ec417b0397c28e24e2 Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung Date: Fri, 4 Oct 2024 15:16:38 +0100 Subject: [PATCH 5/5] openmp, fortran: Add support for iterators in OpenMP 'target update' constructs (Fortran) This adds Fortran support for iterators in 'to' and 'from' clauses in the 'target update' OpenMP directive. 2024-10-04 Kwok Cheung Yeung gcc/fortran/ * dump-parse-tree.cc (show_omp_namelist): Add iterator support for OMP_LIST_TO and OMP_LIST_FROM. * openmp.cc (gfc_free_omp_clauses): Free namespace for OMP_LIST_TO and OMP_LIST_FROM. (gfc_match_motion_var_list): Parse 'iterator' modifier. (resolve_omp_clauses): Resolve iterators for OMP_LIST_TO and OMP_LIST_FROM. * trans-openmp.cc (gfc_trans_omp_clauses): Handle iterators in OMP_LIST_TO and OMP_LIST_FROM clauses. Add expressions to iter_block rather than block. gcc/testsuite/ * gfortran.dg/gomp/target-update-iterators-1.f90: New. * gfortran.dg/gomp/target-update-iterators-2.f90: New. * gfortran.dg/gomp/target-update-iterators-3.f90: New. libgomp/ * testsuite/libgomp.fortran/target-update-iterators-1.f90: New. * testsuite/libgomp.fortran/target-update-iterators-2.f90: New. * testsuite/libgomp.fortran/target-update-iterators-3.f90: New. --- gcc/fortran/dump-parse-tree.cc | 7 +- gcc/fortran/openmp.cc | 62 +++++++++++++-- gcc/fortran/trans-openmp.cc | 50 ++++++++++-- .../gomp/target-update-iterators-1.f90 | 25 ++++++ .../gomp/target-update-iterators-2.f90 | 22 ++++++ .../gomp/target-update-iterators-3.f90 | 23 ++++++ .../target-update-iterators-1.f90 | 68 ++++++++++++++++ .../target-update-iterators-2.f90 | 63 +++++++++++++++ .../target-update-iterators-3.f90 | 78 +++++++++++++++++++ 9 files changed, 386 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 3ee6ed1ea7f..0a2d546d3fe 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -1360,7 +1360,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) { gfc_current_ns = ns_curr; if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND - || list_type == OMP_LIST_MAP) + || list_type == OMP_LIST_MAP + || list_type == OMP_LIST_TO || list_type == OMP_LIST_FROM) { gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr; if (n->u2.ns != ns_iter) @@ -1376,6 +1377,10 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) fputs ("DEPEND (", dumpfile); else if (list_type == OMP_LIST_MAP) fputs ("MAP (", dumpfile); + else if (list_type == OMP_LIST_TO) + fputs ("TO (", dumpfile); + else if (list_type == OMP_LIST_FROM) + fputs ("FROM (", dumpfile); else gcc_unreachable (); } diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 3003ba605cf..c765d5814a7 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -194,7 +194,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) for (i = 0; i < OMP_LIST_NUM; i++) gfc_free_omp_namelist (c->lists[i], i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND - || i == OMP_LIST_MAP, + || i == OMP_LIST_MAP + || i == OMP_LIST_TO || i == OMP_LIST_FROM, i == OMP_LIST_ALLOCATE, i == OMP_LIST_USES_ALLOCATORS, i == OMP_LIST_INIT); @@ -1368,17 +1369,65 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list, if (m != MATCH_YES) return m; - match m_present = gfc_match (" present : "); + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + int present_modifier = 0, iterator_modifier = 0; + locus present_locus = gfc_current_locus, iterator_locus = gfc_current_locus; - m = gfc_match_omp_variable_list ("", list, false, NULL, headp, true, true); + for (;;) + { + locus current_locus = gfc_current_locus; + if (gfc_match ("present ") == MATCH_YES) + { + if (present_modifier++ == 1) + present_locus = current_locus; + } + else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES) + { + if (iterator_modifier++ == 1) + iterator_locus = current_locus; + } + else + break; + gfc_match (", "); + } + + if (present_modifier > 1) + { + gfc_error ("too many % modifiers at %L", + &present_locus); + return MATCH_ERROR; + } + if (iterator_modifier > 1) + { + gfc_error ("too many % modifiers at %L", + &iterator_locus); + return MATCH_ERROR; + } + + if (ns_iter) + gfc_current_ns = ns_iter; + + const char *exp = (present_modifier || iterator_modifier) ? " :" : ""; + m = gfc_match_omp_variable_list (exp, list, false, NULL, headp, true, true); + gfc_current_ns = ns_curr; if (m != MATCH_YES) return m; - if (m_present == MATCH_YES) + + if (present_modifier || iterator_modifier) { gfc_omp_namelist *n; for (n = **headp; n; n = n->next) - n->u.present_modifier = true; + { + if (present_modifier) + n->u.present_modifier = true; + if (iterator_modifier) + { + n->u2.ns = ns_iter; + ns_iter->refs++; + } + } } + return MATCH_YES; } @@ -8881,7 +8930,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, for (; n != NULL; n = n->next) { if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY - || list == OMP_LIST_MAP) + || list == OMP_LIST_MAP + || list == OMP_LIST_TO || list == OMP_LIST_FROM) && n->u2.ns && !n->u2.ns->resolved) { n->u2.ns->resolved = 1; diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index c154975fb0b..c83445d5885 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -4050,11 +4050,39 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_TO: case OMP_LIST_FROM: case OMP_LIST_CACHE: + iterator = NULL_TREE; + prev = NULL; + prev_clauses = omp_clauses; for (; n != NULL; n = n->next) { if (!n->sym->attr.referenced) continue; + if (iterator && prev->u2.ns != n->u2.ns) + { + /* Finish previous iterator group. */ + BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block); + TREE_VEC_ELT (iterator, 5) = tree_block; + for (tree c = omp_clauses; c != prev_clauses; + c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_ITERATORS (c) = iterator; + prev_clauses = omp_clauses; + iterator = NULL_TREE; + } + if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns)) + { + /* Start a new iterator group. */ + gfc_init_block (&iter_block); + tree_block = make_node (BLOCK); + TREE_USED (tree_block) = 1; + BLOCK_VARS (tree_block) = NULL_TREE; + prev_clauses = omp_clauses; + iterator = handle_iterator (n->u2.ns, block, tree_block); + } + if (!iterator) + gfc_init_block (&iter_block); + prev = n; + switch (list) { case OMP_LIST_TO: @@ -4092,7 +4120,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, ptr = build_fold_indirect_ref (ptr); OMP_CLAUSE_DECL (node) = ptr; OMP_CLAUSE_SIZE (node) - = gfc_full_array_size (block, decl, + = gfc_full_array_size (&iter_block, decl, GFC_TYPE_ARRAY_RANK (type)); tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); @@ -4117,7 +4145,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { gfc_conv_expr_reference (&se, n->expr); ptr = se.expr; - gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (&iter_block, &se.pre); OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr))); } @@ -4126,9 +4154,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gfc_conv_expr_descriptor (&se, n->expr); ptr = gfc_conv_array_data (se.expr); tree type = TREE_TYPE (se.expr); - gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (&iter_block, &se.pre); OMP_CLAUSE_SIZE (node) - = gfc_full_array_size (block, se.expr, + = gfc_full_array_size (&iter_block, se.expr, GFC_TYPE_ARRAY_RANK (type)); tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); @@ -4137,7 +4165,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, = fold_build2 (MULT_EXPR, gfc_array_index_type, OMP_CLAUSE_SIZE (node), elemsz); } - gfc_add_block_to_block (block, &se.post); + gfc_add_block_to_block (&iter_block, &se.post); gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); } @@ -4145,8 +4173,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_MOTION_PRESENT (node) = 1; if (list == OMP_LIST_CACHE && n->u.map.readonly) OMP_CLAUSE__CACHE__READONLY (node) = 1; + + if (!iterator) + gfc_add_block_to_block (block, &iter_block); omp_clauses = gfc_trans_add_clause (node, omp_clauses); } + if (iterator) + { + /* Finish last iterator group. */ + BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block); + TREE_VEC_ELT (iterator, 5) = tree_block; + for (tree c = omp_clauses; c != prev_clauses; + c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_ITERATORS (c) = iterator; + } break; case OMP_LIST_USES_ALLOCATORS: /* Ignore pre-defined allocators as no special treatment is needed. */ diff --git a/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90 new file mode 100644 index 00000000000..08dc3d79911 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +program test + implicit none + + integer, parameter :: DIM1 = 17 + integer, parameter :: DIM2 = 39 + + type :: array_ptr + integer, pointer :: ptr(:) + end type + + type (array_ptr) :: x(DIM1), y(DIM1) + + !$omp target update to (iterator(i=1:DIM1): x(i)%ptr(:)) + + !$omp target update to (iterator(i=1:DIM1): x(i)%ptr(:DIM2), y(i)%ptr(:)) + + !$omp target update to (iterator(i=1:DIM1), present: x(i)%ptr(:)) + + !$omp target update to (iterator(i=1:DIM1), iterator(j=i:DIM2): x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." } + + !$omp target update to (iterator(i=1:DIM1), something: x(i, j)) ! { dg-error "Failed to match clause at .1." } +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90 new file mode 100644 index 00000000000..89f645bda23 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +program test + implicit none + + integer, parameter :: DIM1 = 17 + integer, parameter :: DIM2 = 39 + + type :: array_ptr + integer, pointer :: ptr(:) + end type + + type (array_ptr) :: x(DIM1), y(DIM1), z(DIM1) + + !$omp target update to(iterator(i=1:10): x) ! { dg-error "iterator variable .i. not used in clause expression" } + !$omp target update from(iterator(i=1:10, j=1:20): x(i)) ! { dg-error "iterator variable .j. not used in clause expression" } + !$omp target update to(iterator(i=1:10, j=1:20, k=1:30): x(i), y(j), z(k)) + ! { dg-error "iterator variable .i. not used in clause expression" "" { target *-*-* } .-1 } + ! { dg-error "iterator variable .j. not used in clause expression" "" { target *-*-* } .-2 } + ! { dg-error "iterator variable .k. not used in clause expression" "" { target *-*-* } .-3 } +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90 b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90 new file mode 100644 index 00000000000..753811384ae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-omplower" } + +program test + implicit none + + integer, parameter :: DIM1 = 17 + integer, parameter :: DIM2 = 39 + + type :: array_ptr + integer, pointer :: ptr(:) + end type + + type (array_ptr) :: x(DIM1, DIM2), y(DIM1, DIM2), z(DIM1) + + !$omp target update to (iterator(i=1:DIM1, j=1:DIM2): x(i, j)%ptr(:), y(i, j)%ptr(:)) + !$omp target update from (iterator(i=1:DIM1): z(i)%ptr(:)) +end program + +! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto ; else goto ;" 2 "omplower" } } +! { dg-final { scan-tree-dump-times "if \\(j <= 39\\) goto ; else goto ;" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "to\\(iterator\\(integer\\(kind=4\\) j=1:39:1, integer\\(kind=4\\) i=1:17:1\\):D\.\[0-9\]+" 2 "omplower" } } +! { dg-final { scan-tree-dump-times "from\\(iterator\\(integer\\(kind=4\\) i=1:17:1\\):D\.\[0-9\]+" 1 "omplower" } } diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90 new file mode 100644 index 00000000000..e9a13a3c737 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90 @@ -0,0 +1,68 @@ +! { dg-do run } + +! Test target enter data and target update to the target using map +! iterators. + +program test + integer, parameter :: DIM1 = 8 + integer, parameter :: DIM2 = 15 + + type :: array_ptr + integer, pointer :: arr(:) + end type + + type (array_ptr) :: x(DIM1) + integer :: expected, sum, i, j + + expected = mkarray (x) + + !$omp target enter data map(to: x) + !$omp target enter data map(iterator(i=1:DIM1), to: x(i)%arr(:)) + !$omp target map(from: sum) + sum = 0 + do i = 1, DIM1 + do j = 1, DIM2 + sum = sum + x(i)%arr(j) + end do + end do + !$omp end target + + print *, sum, expected + if (sum .ne. expected) stop 1 + + expected = 0 + do i = 1, DIM1 + do j = 1, DIM2 + x(i)%arr(j) = x(i)%arr(j) * i * j + expected = expected + x(i)%arr(j) + end do + end do + + !$omp target update to(iterator(i=1:DIM1): x(i)%arr(:)) + + !$omp target map(from: sum) + sum = 0 + do i = 1, DIM1 + do j = 1, DIM2 + sum = sum + x(i)%arr(j) + end do + end do + !$omp end target + + if (sum .ne. expected) stop 2 +contains + integer function mkarray (x) + type (array_ptr), intent(inout) :: x(DIM1) + integer :: exp = 0 + + do i = 1, DIM1 + allocate (x(i)%arr(DIM2)) + do j = 1, DIM2 + x(i)%arr(j) = i * j + exp = exp + x(i)%arr(j) + end do + end do + + mkarray = exp + end function +end program diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90 new file mode 100644 index 00000000000..2e982bc032c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90 @@ -0,0 +1,63 @@ +! { dg-do run } +! { dg-require-effective-target offload_device_nonshared_as } + +! Test target enter data and target update from the target using map +! iterators. + +program test + integer, parameter :: DIM1 = 8 + integer, parameter :: DIM2 = 15 + + type :: array_ptr + integer, pointer :: arr(:) + end type + + type (array_ptr) :: x(DIM1) + integer :: sum, expected + + call mkarray (x) + + !$omp target enter data map(to: x(:DIM1)) + !$omp target enter data map(iterator(i=1:DIM1), to: x(i)%arr(:)) + !$omp target map(from: expected) + expected = 0 + do i = 1, DIM1 + do j = 1, DIM2 + x(i)%arr(j) = (i + 1) * (j + 2) + expected = expected + x(i)%arr(j) + end do + end do + !$omp end target + + ! Host copy of x should remain unchanged. + sum = 0 + do i = 1, DIM1 + do j = 1, DIM2 + sum = sum + x(i)%arr(j) + end do + end do + if (sum .ne. 0) stop 1 + + !$omp target update from(iterator(i=1:DIM1): x(i)%arr(:)) + + ! Host copy should now be updated. + sum = 0 + do i = 1, DIM1 + do j = 1, DIM2 + sum = sum + x(i)%arr(j) + end do + end do + + if (sum .ne. expected) stop 2 +contains + subroutine mkarray (x) + type (array_ptr), intent(inout) :: x(DIM1) + + do i = 1, DIM1 + allocate (x(i)%arr(DIM2)) + do j = 1, DIM2 + x(i)%arr(j) = 0 + end do + end do + end subroutine +end program diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90 new file mode 100644 index 00000000000..54b2a6c37c1 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90 @@ -0,0 +1,78 @@ +! { dg-do run } +! { dg-require-effective-target offload_device_nonshared_as } + +! Test target enter data and target update to the target using map +! iterators with a function. + +program test + implicit none + + integer, parameter :: DIM1 = 8 + integer, parameter :: DIM2 = 15 + + type :: array_ptr + integer, pointer :: arr(:) + end type + + type (array_ptr) :: x(DIM1) + integer :: x_new(DIM1, DIM2) + integer :: expected, sum, i, j + + call mkarray (x) + + !$omp target enter data map(to: x(:DIM1)) + !$omp target enter data map(iterator(i=1:DIM1), to: x(i)%arr(:)) + + ! Update x on host. + do i = 1, DIM1 + do j = 1, DIM2 + x_new(i, j) = x(i)%arr(j) + x(i)%arr(j) = (i + 1) * (j + 2); + end do + end do + + ! Update a subset of x on target. + !$omp target update to(iterator(i=1:DIM1/2): x(f (i))%arr(:)) + + !$omp target map(from: sum) + sum = 0 + do i = 1, DIM1 + do j = 1, DIM2 + sum = sum + x(i)%arr(j) + end do + end do + !$omp end target + + ! Calculate expected value on host. + do i = 1, DIM1/2 + do j = 1, DIM2 + x_new(f (i), j) = x(f (i))%arr(j) + end do + end do + + expected = 0 + do i = 1, DIM1 + do j = 1, DIM2 + expected = expected + x_new(i, j) + end do + end do + + if (sum .ne. expected) stop 1 +contains + subroutine mkarray (x) + type (array_ptr), intent(inout) :: x(DIM1) + + do i = 1, DIM1 + allocate (x(i)%arr(DIM2)) + do j = 1, DIM2 + x(i)%arr(j) = i * j + end do + end do + end subroutine + + integer function f (i) + integer, intent(in) :: i + + f = i * 2 + end function +end program