From patchwork Fri Oct 4 14:58:23 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: 1992782 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=RjIQh8sF; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; 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 [8.43.85.97]) (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 4XKsC559kbz1xv2 for ; Sat, 5 Oct 2024 00:59:29 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BC880386F471 for ; Fri, 4 Oct 2024 14:59:27 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ej1-x62a.google.com (mail-ej1-x62a.google.com [IPv6:2a00:1450:4864:20::62a]) by sourceware.org (Postfix) with ESMTPS id 55A62386D620 for ; Fri, 4 Oct 2024 14:58:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 55A62386D620 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 55A62386D620 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::62a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1728053937; cv=none; b=sGx7IYaImeG15rE/wHKr6k6R29cQnA+pAYGJwixFUJh5CgDlpcuvjO3fFLg0DQz40mX/L++IpJTMaGPJU089HkmvlUbyos7RIE19qKMgbM5SCjzi0NKeG7KrO03YlBFYmEyNMJ3wi1WmFw3J+QOiyaaPNvJ6c7GbO37ZQ7N0C7U= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1728053937; c=relaxed/simple; bh=7uwNx11SgGpTtfVPeYUW07/4eeGE3GEBkKA/70tmU2A=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:Subject:From; b=t7EdLnyK+oAHwZ9uu7ciTeRu8F/EG1PmSAiJ2oHNllOwKMlAK1Mv0dVo9WPICVK1c25GGtd1tNUTmcjUSiYQattU6vw8P6gC4qQL6jah3B4/3dmFMBbrk/YA0Qq/esC7mvxGJ4Otav44fkzDyWU9dad7fBzJBuIzTqP6u/kRNOs= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-ej1-x62a.google.com with SMTP id a640c23a62f3a-a8a6d1766a7so335057666b.3 for ; Fri, 04 Oct 2024 07:58:52 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=baylibre-com.20230601.gappssmtp.com; s=20230601; t=1728053931; x=1728658731; 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=Jl03BM/sW+Gj646eByPO/EWuXr6PtdhMWa/cduvFhVQ=; b=RjIQh8sFsiH7fmNPFaPCgJDzBJVBDGSWjNLOpoUWnynMeoEWUW1O1slOBaa01wSg0u m3/91uglxa4VoG74sTLkXeSAecmxjQcZ27NP/W8BQ41m+6beuCsBu5ZNLzY1Wu4Tlen5 zysnejMKoZWDf+B1vFaZkYZPp1olTd4PKT2F4kKMZpL0CkiHSFvo8P9+lvg0A0G9nyNc /Ac+s+CQrOKi+a9srz5jnVt7Jo0sK1RXjZjs3bTAjxtbtCPdFS/6aVqGnF+IIoKsk4DV Iiq1MMhCjGUb/KRr75BzRAQ69Y5JvHbBYXWzYypaaH5HaOpKkPo5U4PTQOhoxWr53DxD H5dQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1728053931; x=1728658731; 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=Jl03BM/sW+Gj646eByPO/EWuXr6PtdhMWa/cduvFhVQ=; b=olXgS6g48gKMJSX/8Mr055sKnzI7ELQbaxi3VImDpg1MWTV77j4pEHmII+GBKUOHV8 oBJz9i6nh02HFZTH9HYKUGtaKVLSaxGw5ljrZdQJaCxY9C2owRgmAF2Rh2uB2Z7zhOBI P4PjXJZJ1Pgdmt7V/P+68QT3m4+o0vzrxid+1jA6w4GZtbxqQPbFgkTPeZnRYWtgp6lP R1y+B44SXv1LnhjEdmv+hX00uj4GXn0pyYf7Fvhb6Ha7zgOEKJPQvVfOqGHppxyAGbcl pFGEseRrMmz84yegxkHEcIjulrEjcPG/qHs86+naw5ZGRM6XH/p6Tu6xgMQmnAb8usqv GZFg== X-Gm-Message-State: AOJu0YxlqGyq/O7fmtAqqfc1GFzLr1hO9JgEoMT8uL+0V0Jc4DIJmn1A 9hNQH+a2Vlekct1dIGJEyFa5BnzMv9IGNFPWnaP8kkiF7NQvrjIZ0tf+i9G3RWL23aefk8yqxMY B X-Google-Smtp-Source: AGHT+IF8bU55qx0EX7dOoRYNwhXeeAwwntdkTOIbbmQBgzolOauQBgwKz7psdiIGNM3QHkgtQ1nIRA== X-Received: by 2002:a17:906:730f:b0:a86:8917:fcd6 with SMTP id a640c23a62f3a-a991c022d25mr282140466b.60.1728053930488; Fri, 04 Oct 2024 07:58:50 -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-a992e784a84sm1310966b.117.2024.10.04.07.58.49 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 04 Oct 2024 07:58:50 -0700 (PDT) Message-ID: <300ddbe2-4ad9-49ef-9f24-a02649a64bb9@baylibre.com> Date: Fri, 4 Oct 2024 15:58:23 +0100 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird To: gcc-patches , Jakub Jelinek , Tobias Burnus , fortran@gcc.gnu.org References: <6b94b8ed-020b-47e2-b02a-4891891f2847@baylibre.com> Subject: [PATCH v3 4/5] openmp, fortran: Add support for map iterators in OpenMP target construct (Fortran) Content-Language: en-GB From: Kwok Cheung Yeung In-Reply-To: <6b94b8ed-020b-47e2-b02a-4891891f2847@baylibre.com> X-Spam-Status: No, score=-12.8 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 support for iterators in the map clause of OpenMP target constructs. The parsing and translation of iterators in the front-end works the same way as for the affinity and depend clauses, except for putting the iterator into the OMP_CLAUSE_ITERATOR of the clause. The iterator gimplification needed to be modified slightly to handle Fortran. The difference in how ranges work in loops (i.e. the condition on the upper bound is <=, rather than < as in C/C++) needs to be compensated for when calculating the iteration count and in the iteration loop itself. During Fortran translation of iterators, statements for the side-effects of any translated expressions are placed into BLOCK_SUBBLOCKS of the block containing the iterator variables (this also occurs with the other clauses supporting iterators). However, the previous lowering of iterators into Gimple does not appear to do anything with these statements, which causes issues if anything in the loop body references these side-effects (typically calculation of array boundaries and strides). This appears to be a bug that was simply not triggered by existing testcases. These statements are now gimplified into the innermost loop body. The libgomp runtime was modified to handle GOMP_MAP_STRUCTs in iterators, which can result from the use of derived types (which I used in test cases to implement arrays of pointers). libgomp expects a GOMP_MAP_STRUCT map to be followed immediately by a number of maps corresponding to the fields of the struct, so an iterator GOMP_MAP_STRUCT and its fields need to be expanded in a breadth-first order, rather than the usual depth-first manner (which would result in multiple GOMP_MAP_STRUCTS, followed by multiple instances of the first field, then multiples of the second etc.). The presence of variables in the field offset triggers the unwanted creation of GOMP_MAP_STRUCT_UNORD for variable offsets. The offset tree is now walked over and if it only contains iterator variables, then the offset is treated as constant again (which it is, within the context of each iteration of the iterator). From a24aa032c2e23577d4fbc61df6da79345bae8292 Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung Date: Fri, 4 Oct 2024 15:16:29 +0100 Subject: [PATCH 4/5] openmp, fortran: Add support for map iterators in OpenMP target construct (Fortran) This adds support for iterators in map clauses within OpenMP 'target' constructs in Fortran. Some special handling for struct field maps has been added to libgomp in order to handle arrays of derived types. 2024-10-04 Kwok Cheung Yeung gcc/fortran/ * dump-parse-tree.cc (show_omp_namelist): Add iterator support for OMP_LIST_MAP. * openmp.cc (gfc_free_omp_clauses): Free namespace in namelist for OMP_LIST_MAP. (gfc_match_omp_clauses): Parse 'iterator' modifier for 'map' clause. (resolve_omp_clauses): Resolve iterators for OMP_LIST_MAP. * trans-openmp.cc (gfc_trans_omp_clauses): Handle iterators in OMP_LIST_MAP clauses. Add expressions to iter_block rather than block. gcc/ * gimplify.cc (compute_iterator_count): Account for difference in loop boundaries in Fortran. (build_iterator_loop): Change upper boundary condition for Fortran. Insert block statements into innermost loop. (contains_only_iterator_vars_1): New. (contains_only_iterator_vars): New. (extract_base_bit_offset): Add iterator argument. Do not set variable_offset if contains_only_iterator_vars is true. (omp_accumulate_sibling_list): Add iterator argument to extract_base_bit_offset. * omp-low.cc (lower_omp_target): Add sorry if iterators used with deep mapping. * tree-pretty-print.cc (dump_block_node): Ignore BLOCK_SUBBLOCKS containing iterator block statements. gcc/testsuite/ * gfortran.dg/gomp/target-map-iterators-1.f90: New. * gfortran.dg/gomp/target-map-iterators-2.f90: New. * gfortran.dg/gomp/target-map-iterators-3.f90: New. libgomp/ * target.c (kind_to_name): Handle GOMP_MAP_STRUCT and GOMP_MAP_STRUCT_UNORD. (gomp_add_map): New. (gomp_merge_iterator_maps): Expand fields of a struct mapping breadth-first. * testsuite/libgomp.fortran/target-map-iterators-1.f90: New. * testsuite/libgomp.fortran/target-map-iterators-2.f90: New. * testsuite/libgomp.fortran/target-map-iterators-3.f90: New. --- gcc/fortran/dump-parse-tree.cc | 9 +- gcc/fortran/openmp.cc | 35 ++++++-- gcc/fortran/trans-openmp.cc | 71 ++++++++++++---- gcc/gimplify.cc | 76 ++++++++++++++--- gcc/omp-low.cc | 5 ++ .../gomp/target-map-iterators-1.f90 | 26 ++++++ .../gomp/target-map-iterators-2.f90 | 27 ++++++ .../gomp/target-map-iterators-3.f90 | 24 ++++++ gcc/tree-pretty-print.cc | 4 +- libgomp/target.c | 83 ++++++++++++++----- .../target-map-iterators-1.f90 | 45 ++++++++++ .../target-map-iterators-2.f90 | 45 ++++++++++ .../target-map-iterators-3.f90 | 57 +++++++++++++ 13 files changed, 452 insertions(+), 55 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 3547d7f8aca..3ee6ed1ea7f 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -1359,7 +1359,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) for (; n; n = n->next) { gfc_current_ns = ns_curr; - if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND) + if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND + || list_type == OMP_LIST_MAP) { gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr; if (n->u2.ns != ns_iter) @@ -1371,8 +1372,12 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) fputs ("AFFINITY (", dumpfile); else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST) fputs ("DOACROSS (", dumpfile); - else + else if (list_type == OMP_LIST_DEPEND) fputs ("DEPEND (", dumpfile); + else if (list_type == OMP_LIST_MAP) + fputs ("MAP (", dumpfile); + else + gcc_unreachable (); } if (n->u2.ns) { diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 2d5c4305d2a..3003ba605cf 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -193,7 +193,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->vector_length_expr); 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_AFFINITY || i == OMP_LIST_DEPEND + || i == OMP_LIST_MAP, i == OMP_LIST_ALLOCATE, i == OMP_LIST_USES_ALLOCATORS, i == OMP_LIST_INIT); @@ -3477,9 +3478,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, int always_modifier = 0; int close_modifier = 0; int present_modifier = 0; + int iterator_modifier = 0; + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; locus second_always_locus = old_loc2; locus second_close_locus = old_loc2; locus second_present_locus = old_loc2; + locus second_iterator_locus = old_loc2; for (;;) { @@ -3499,6 +3503,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (present_modifier++ == 1) second_present_locus = current_locus; } + else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES) + { + if (iterator_modifier++ == 1) + second_iterator_locus = current_locus; + } else break; gfc_match (", "); @@ -3555,15 +3564,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, &second_present_locus); break; } + if (iterator_modifier > 1) + { + gfc_error ("too many % modifiers at %L", + &second_iterator_locus); + break; + } head = NULL; - if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], + if (ns_iter) + gfc_current_ns = ns_iter; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], false, NULL, &head, - true, true) == MATCH_YES) + true, true); + gfc_current_ns = ns_curr; + if (m == MATCH_YES) { gfc_omp_namelist *n; for (n = *head; n; n = n->next) - n->u.map.op = map_op; + { + n->u.map.op = map_op; + n->u2.ns = ns_iter; + if (ns_iter) + ns_iter->refs++; + } continue; } gfc_current_locus = old_loc; @@ -8856,7 +8880,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { - if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY) + if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY + || list == OMP_LIST_MAP) && 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 3a335ade0f7..c154975fb0b 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2694,7 +2694,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false, bool openacc = false, gfc_exec_op op = EXEC_NOP) { - tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c; + tree omp_clauses = NULL_TREE, prev_clauses = NULL_TREE, chunk_size, c; tree iterator = NULL_TREE; tree tree_block = NULL_TREE; stmtblock_t iter_block; @@ -3129,11 +3129,39 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } break; case OMP_LIST_MAP: + 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; + bool always_modifier = false; tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); tree node2 = NULL_TREE; @@ -3332,7 +3360,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, TRUTH_NOT_EXPR, boolean_type_node, present); - gfc_add_expr_to_block (block, + gfc_add_expr_to_block (&iter_block, build3_loc (input_location, COND_EXPR, void_type_node, @@ -3392,7 +3420,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree type = TREE_TYPE (decl); tree ptr = gfc_conv_descriptor_data_get (decl); if (present) - ptr = gfc_build_cond_assign_expr (block, present, ptr, + ptr = gfc_build_cond_assign_expr (&iter_block, + present, ptr, null_pointer_node); gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); ptr = build_fold_indirect_ref (ptr); @@ -3420,7 +3449,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, ptr = gfc_conv_descriptor_data_get (decl); ptr = gfc_build_addr_expr (NULL, ptr); ptr = gfc_build_cond_assign_expr ( - block, present, ptr, null_pointer_node); + &iter_block, present, ptr, null_pointer_node); ptr = build_fold_indirect_ref (ptr); OMP_CLAUSE_DECL (node3) = ptr; } @@ -3509,7 +3538,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, TRUTH_ANDIF_EXPR, boolean_type_node, present, cond); - gfc_add_expr_to_block (block, + gfc_add_expr_to_block (&iter_block, build3_loc (input_location, COND_EXPR, void_type_node, @@ -3538,12 +3567,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree cond = build3_loc (input_location, COND_EXPR, void_type_node, present, cond_body, NULL_TREE); - gfc_add_expr_to_block (block, cond); + gfc_add_expr_to_block (&iter_block, cond); OMP_CLAUSE_SIZE (node) = var; } else { - gfc_add_block_to_block (block, &cond_block); + gfc_add_block_to_block (&iter_block, &cond_block); OMP_CLAUSE_SIZE (node) = size; } } @@ -3555,7 +3584,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, /* A single indirectref is handled by the middle end. */ gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl))); decl = TREE_OPERAND (decl, 0); - decl = gfc_build_cond_assign_expr (block, present, decl, + decl = gfc_build_cond_assign_expr (&iter_block, + present, decl, null_pointer_node); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl); } @@ -3589,7 +3619,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, size_type_node, cond, size, size_zero_node); - size = gfc_evaluate_now (size, block); + size = gfc_evaluate_now (size, &iter_block); OMP_CLAUSE_SIZE (node) = size; } } @@ -3608,7 +3638,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, && !(POINTER_TYPE_P (type) && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))) k = GOMP_MAP_FIRSTPRIVATE_POINTER; - gfc_trans_omp_array_section (block, op, n, decl, element, + gfc_trans_omp_array_section (&iter_block, + op, n, decl, element, !openacc, k, node, node2, node3, node4); } @@ -3626,12 +3657,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gfc_init_se (&se, NULL); gfc_conv_expr (&se, n->expr); - gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (&iter_block, &se.pre); /* For BT_CHARACTER a pointer is returned. */ OMP_CLAUSE_DECL (node) = POINTER_TYPE_P (TREE_TYPE (se.expr)) ? build_fold_indirect_ref (se.expr) : se.expr; - gfc_add_block_to_block (block, &se.post); + gfc_add_block_to_block (&iter_block, &se.post); if (pointer || allocatable) { /* If it's a bare attach/detach clause, we just want @@ -3843,7 +3874,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_DECL (node) = ptr; int rank = GFC_TYPE_ARRAY_RANK (type); OMP_CLAUSE_SIZE (node) - = gfc_full_array_size (block, inner, rank); + = gfc_full_array_size (&iter_block, inner, rank); tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); map_kind = OMP_CLAUSE_MAP_KIND (node); @@ -3981,7 +4012,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, /* An array element or section. */ bool element = lastref->u.ar.type == AR_ELEMENT; gomp_map_kind kind = GOMP_MAP_ATTACH_DETACH; - gfc_trans_omp_array_section (block, op, n, inner, element, + gfc_trans_omp_array_section (&iter_block, + op, n, inner, element, !openacc, kind, node, node2, node3, node4); } @@ -3993,6 +4025,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, finalize_map_clause: + if (!iterator) + gfc_add_block_to_block (block, &iter_block); omp_clauses = gfc_trans_add_clause (node, omp_clauses); if (node2) omp_clauses = gfc_trans_add_clause (node2, omp_clauses); @@ -4003,6 +4037,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (node5) omp_clauses = gfc_trans_add_clause (node5, 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_TO: case OMP_LIST_FROM: diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index ba972a2892a..4e30d335324 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -8858,10 +8858,17 @@ compute_iterator_count (tree it, gimple_seq *pre_p) endmbegin = fold_build2_loc (loc, POINTER_DIFF_EXPR, stype, end, begin); else endmbegin = fold_build2_loc (loc, MINUS_EXPR, type, end, begin); - tree stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step, - build_int_cst (stype, 1)); - tree stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step, - build_int_cst (stype, 1)); + /* Account for iteration stopping on the end value in Fortran rather + than before it. */ + tree stepm1 = step; + tree stepp1 = step; + if (!lang_GNU_Fortran ()) + { + stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step, + build_int_cst (stype, 1)); + stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step, + build_int_cst (stype, 1)); + } tree pos = fold_build2_loc (loc, PLUS_EXPR, stype, unshare_expr (endmbegin), stepm1); pos = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, pos, step); @@ -8905,6 +8912,7 @@ build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind) if (*last_bind) gimplify_and_add (*last_bind, pre_p); tree block = TREE_VEC_ELT (it, 5); + tree block_stmts = lang_GNU_Fortran () ? BLOCK_SUBBLOCKS (block) : NULL_TREE; *last_bind = build3 (BIND_EXPR, void_type_node, BLOCK_VARS (block), NULL, block); TREE_SIDE_EFFECTS (*last_bind) = 1; @@ -8916,6 +8924,7 @@ build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind) tree end = TREE_VEC_ELT (it, 2); tree step = TREE_VEC_ELT (it, 3); tree orig_step = TREE_VEC_ELT (it, 4); + block = TREE_VEC_ELT (it, 5); tree type = TREE_TYPE (var); location_t loc = DECL_SOURCE_LOCATION (var); /* Emit: @@ -8926,9 +8935,9 @@ build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind) var = var + step; cond_label: if (orig_step > 0) { - if (var < end) goto beg_label; + if (var < end) goto beg_label; // <= for Fortran } else { - if (var > end) goto beg_label; + if (var > end) goto beg_label; // >= for Fortran } for each iterator, with inner iterators added to the ... above. */ @@ -8954,10 +8963,12 @@ build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind) append_to_statement_list_force (tem, p); tem = build1 (LABEL_EXPR, void_type_node, cond_label); append_to_statement_list (tem, p); - tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, var, end); + tree cond = fold_build2_loc (loc, lang_GNU_Fortran () ? LE_EXPR : LT_EXPR, + boolean_type_node, var, end); tree pos = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, build_and_jump (&beg_label), void_node); - cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, var, end); + cond = fold_build2_loc (loc, lang_GNU_Fortran () ? GE_EXPR : GT_EXPR, + boolean_type_node, var, end); tree neg = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, build_and_jump (&beg_label), void_node); tree osteptype = TREE_TYPE (orig_step); @@ -8966,6 +8977,11 @@ build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind) tem = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, pos, neg); append_to_statement_list_force (tem, p); p = &BIND_EXPR_BODY (bind); + /* The Fortran front-end stashes statements into the BLOCK_SUBBLOCKS + of the last element of the first iterator. These should go into the + body of the innermost loop. */ + if (!TREE_CHAIN (it)) + append_to_statement_list_force (block_stmts, p); } return p; @@ -9406,6 +9422,34 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end, return c2; } +/* Callback for walk_tree. Return any VAR_DECLS that are not found in the + iterators stored in DATA. */ + +static tree +contains_only_iterator_vars_1 (tree* tp, int *, void *data) +{ + tree iterators = (tree) data; + tree t = *tp; + + if (TREE_CODE (t) != VAR_DECL) + return NULL_TREE; + + for (tree it = iterators; it; it = TREE_CHAIN (it)) + if (t == TREE_VEC_ELT (it, 0)) + return NULL_TREE; + + return t; +} + +/* Return true if the only variables present in EXPR are iterator variables in + ITERATORS. */ + +static bool +contains_only_iterator_vars (tree expr, tree iterators) +{ + return !walk_tree (&expr, contains_only_iterator_vars_1, iterators, NULL); +} + /* Strip ARRAY_REFS or an indirect ref off BASE, find the containing object, and set *BITPOSP and *POFFSETP to the bit offset of the access. If BASE_REF is non-NULL and the containing object is a reference, set @@ -9416,7 +9460,8 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end, static tree extract_base_bit_offset (tree base, poly_int64 *bitposp, poly_offset_int *poffsetp, - bool *variable_offset) + bool *variable_offset, + tree iterator) { tree offset; poly_int64 bitsize, bitpos; @@ -9440,6 +9485,8 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp, { poffset = 0; *variable_offset = (offset != NULL_TREE); + if (iterator && *variable_offset) + *variable_offset = !contains_only_iterator_vars (offset, iterator); } if (maybe_ne (bitpos, 0)) @@ -11245,8 +11292,11 @@ omp_accumulate_sibling_list (enum omp_region_type region_type, } bool variable_offset; + tree iterators = OMP_CLAUSE_HAS_ITERATORS (grp_end) + ? OMP_CLAUSE_ITERATORS (grp_end) : NULL_TREE; tree base - = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset); + = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset, + iterators); int base_token; for (base_token = addr_tokens.length () - 1; base_token >= 0; base_token--) @@ -11579,8 +11629,12 @@ omp_accumulate_sibling_list (enum omp_region_type region_type, sc_decl = TREE_OPERAND (sc_decl, 0); bool variable_offset2; + tree iterators2 = OMP_CLAUSE_HAS_ITERATORS (*sc) + ? OMP_CLAUSE_ITERATORS (*sc) : NULL_TREE; + tree base2 = extract_base_bit_offset (sc_decl, &bitpos, &offset, - &variable_offset2); + &variable_offset2, + iterators2); if (!base2 || !operand_equal_p (base2, base, 0)) break; if (scp) diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index a8b86889c66..46f40a14646 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -12938,6 +12938,11 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) deep_map_cnt = extra; } + if (deep_map_cnt + && OMP_CLAUSE_HAS_ITERATORS (c) && OMP_CLAUSE_ITERATORS (c)) + sorry ("iterators used together with deep mapping are not " + "supported yet"); + if (!DECL_P (var)) { if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 new file mode 100644 index 00000000000..25abbaf741e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +program main + 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 map (iterator(i=1:DIM1), to: x(i)%ptr(:)) + !$omp end target + + !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:), y(i)%ptr(:)) + !$omp end target + + !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:) + 3) ! { dg-error "Syntax error in OpenMP variable list at .1." } + !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." } + + !$omp target map(iterator(i=1:DIM1), iterator(j=1:DIM2), to: x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." } + !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." } +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 new file mode 100644 index 00000000000..b7d7501cf63 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +program main + implicit none + + integer, parameter :: DIM = 40 + type :: array_ptr + integer, pointer :: ptr(:) + end type + + type (array_ptr) :: x(DIM), y(DIM), z(DIM) + + !$omp target map(iterator(i=1:10), to: x) ! { dg-error "iterator variable .i. not used in clause expression" } + ! Add a reference to x to ensure that the 'to' clause does not get dropped. + x(1)%ptr(1) = 0 + !$omp end target + + !$omp target map(iterator(i=1:10, j=1:20), to: x(i)) ! { dg-error "iterator variable .j. not used in clause expression" } + !$omp end target + + !$omp target map(iterator(i=1:10, j=1:20, k=1:30), to: x(i), y(j), z(k)) + !$omp end target + ! { dg-error "iterator variable .i. not used in clause expression" "" { target *-*-* } .-2 } + ! { dg-error "iterator variable .j. not used in clause expression" "" { target *-*-* } .-3 } + ! { dg-error "iterator variable .k. not used in clause expression" "" { target *-*-* } .-4 } +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 new file mode 100644 index 00000000000..785f149c0d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-omplower" } + +program main + implicit none + + integer, parameter :: DIM1 = 17 + integer, parameter :: DIM2 = 27 + type :: ptr_t + integer, pointer :: ptr(:) + end type + + type (ptr_t) :: x(DIM1), y(DIM2) + + !$omp target map(iterator(i=1:DIM1), to: x(i)%ptr(:)) map(iterator(i=1:DIM2), from: y(i)%ptr(:)) + !$omp end target +end program + +! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto ; else goto ;" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "if \\(i <= 27\\) goto ; else goto ;" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1\\):to:D\.\[0-9\]+" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1\\):from:D\.\[0-9\]+" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1\\):attach:D\.\[0-9\]+" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1\\):attach:D\.\[0-9\]+" 1 "omplower" } } diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index fa1b2dce27f..da6b757e212 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -1671,7 +1671,9 @@ dump_block_node (pretty_printer *pp, tree block, int spc, dump_flags_t flags) newline_and_indent (pp, spc + 2); } - if (BLOCK_SUBBLOCKS (block)) + if (BLOCK_SUBBLOCKS (block) + && (!lang_GNU_Fortran () + || TREE_CODE (BLOCK_SUBBLOCKS (block)) != STATEMENT_LIST)) { pp_string (pp, "SUBBLOCKS: "); for (t = BLOCK_SUBBLOCKS (block); t; t = BLOCK_CHAIN (t)) diff --git a/libgomp/target.c b/libgomp/target.c index 60d57a19dd0..e8205f6c309 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -993,10 +993,48 @@ kind_to_name (unsigned short kind) case GOMP_MAP_POINTER: return "GOMP_MAP_POINTER"; case GOMP_MAP_ATTACH: return "GOMP_MAP_ATTACH"; case GOMP_MAP_DETACH: return "GOMP_MAP_DETACH"; + case GOMP_MAP_STRUCT: return "GOMP_MAP_STRUCT"; + case GOMP_MAP_STRUCT_UNORD: return "GOMP_MAP_STRUCT_UNORD"; default: return "unknown"; } } +static void +gomp_add_map (size_t idx, size_t *new_idx, + void ***hostaddrs, size_t **sizes, unsigned short **skinds, + void ***new_hostaddrs, size_t **new_sizes, + unsigned short **new_kinds, size_t *iterator_count) +{ + if ((*sizes)[idx] == SIZE_MAX) + { + uintptr_t *iterator_array = (*hostaddrs)[idx]; + size_t count = *iterator_array++; + for (size_t i = 0; i < count; i++) + { + (*new_hostaddrs)[*new_idx] = (void *) *iterator_array++; + (*new_sizes)[*new_idx] = *iterator_array++; + (*new_kinds)[*new_idx] = (*skinds)[idx]; + iterator_count[*new_idx] = i + 1; + gomp_debug (1, + "Expanding map %u <%s>: " + "hostaddrs[%u] = %p, sizes[%u] = %lu\n", + (int) idx, kind_to_name ((*new_kinds)[*new_idx]), + (int) *new_idx, (*new_hostaddrs)[*new_idx], + (int) *new_idx, (unsigned long) (*new_sizes)[*new_idx]); + (*new_idx)++; + } + } + else + { + (*new_hostaddrs)[*new_idx] = (*hostaddrs)[idx]; + (*new_sizes)[*new_idx] = (*sizes)[idx]; + (*new_kinds)[*new_idx] = (*skinds)[idx]; + iterator_count[*new_idx] = 0; + (*new_idx)++; + } +} + + /* Map entries containing expanded iterators will be flattened and merged into HOSTADDRS, SIZES and KINDS, and MAPNUM updated. Returns true if there are any iterators found. ITERATOR_COUNT holds the iteration count of the @@ -1037,33 +1075,34 @@ gomp_merge_iterator_maps (size_t *mapnum, void ***hostaddrs, size_t **sizes, for (size_t i = 0; i < *mapnum; i++) { - if ((*sizes)[i] == SIZE_MAX) + int map_type = get_kind (true, *skinds, i) & 0xff; + if (map_type == GOMP_MAP_STRUCT || map_type == GOMP_MAP_STRUCT_UNORD) { - uintptr_t *iterator_array = (*hostaddrs)[i]; - size_t count = *iterator_array++; - for (size_t j = 0; j < count; j++) + size_t field_count = (*sizes)[i]; + + gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds, + &new_hostaddrs, &new_sizes, &new_kinds, + *iterator_count); + + for (size_t j = i + 1; j <= i + field_count; j++) { - new_hostaddrs[new_idx] = (void *) *iterator_array++; - new_sizes[new_idx] = *iterator_array++; - new_kinds[new_idx] = (*skinds)[i]; - (*iterator_count)[new_idx] = j + 1; - gomp_debug (1, - "Expanding map %u <%s>: " - "hostaddrs[%u] = %p, sizes[%u] = %lu\n", - (int) i, kind_to_name (new_kinds[new_idx]), - (int) new_idx, new_hostaddrs[new_idx], - (int) new_idx, (unsigned long) new_sizes[new_idx]); - new_idx++; + if ((*sizes)[j] == SIZE_MAX) + { + uintptr_t *iterator_array = (*hostaddrs)[j]; + size_t count = iterator_array[0]; + new_sizes[i] += count - 1; + } + gomp_add_map (j, &new_idx, hostaddrs, sizes, skinds, + &new_hostaddrs, &new_sizes, &new_kinds, + *iterator_count); } + gomp_debug (1, "Map %u: new field count = %lu\n", + (int) i, (unsigned long) new_sizes[i]); + i += field_count; } else - { - new_hostaddrs[new_idx] = (*hostaddrs)[i]; - new_sizes[new_idx] = (*sizes)[i]; - new_kinds[new_idx] = (*skinds)[i]; - (*iterator_count)[new_idx] = 0; - new_idx++; - } + gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds, + &new_hostaddrs, &new_sizes, &new_kinds, *iterator_count); } *mapnum = map_count; diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90 new file mode 100644 index 00000000000..80e077e69fd --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90 @@ -0,0 +1,45 @@ +! { dg-do run } + +! Test transfer of dynamically-allocated arrays to target using map +! iterators. + +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 :: expected, sum, i, j + + expected = mkarray () + + !$omp target map(iterator(i=1:DIM1), to: x(i)%arr(:)) 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 1 +contains + integer function mkarray () + 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-map-iterators-2.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90 new file mode 100644 index 00000000000..cf0e7fbd9b3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90 @@ -0,0 +1,45 @@ +! { dg-do run } + +! Test transfer of dynamically-allocated arrays from target using map +! iterators. + +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 :: expected, sum, i, j + + call mkarray + + !$omp target map(iterator(i=1:DIM1), from: x(i)%arr(:)) map(from: expected) + expected = 0 + do i = 1, DIM1 + do j = 1, DIM2 + x(i)%arr(j) = (i+1) * (j+1) + expected = expected + x(i)%arr(j) + end do + end do + !$omp end target + + 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 1 +contains + subroutine mkarray + do i = 1, DIM1 + allocate (x(i)%arr(DIM2)) + end do + end subroutine +end program diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90 new file mode 100644 index 00000000000..8072c074557 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90 @@ -0,0 +1,57 @@ +! { dg-do run } + +! Test transfer of dynamically-allocated arrays to target using map +! iterators, with multiple iterators and function calls in the iterator +! expression. + +program test + implicit none + + integer, parameter :: DIM1 = 16 + integer, parameter :: DIM2 = 4 + + type :: array_ptr + integer, pointer :: arr(:) + end type + + type (array_ptr) :: x(DIM1), y(DIM1) + integer :: expected, sum, i, j + + expected = mkarrays () + + !$omp target map(iterator(i=0:DIM1/4-1, j=0:3), to: x(f (i, j))%arr(:)) & + !$omp map(iterator(i=1:DIM1), to: y(i)%arr(:)) & + !$omp map(from: sum) + sum = 0 + do i = 1, DIM1 + do j = 1, DIM2 + sum = sum + x(i)%arr(j) * y(i)%arr(j) + end do + end do + !$omp end target + + print *, sum, expected + if (sum .ne. expected) stop 1 +contains + integer function mkarrays () + integer :: exp = 0 + + do i = 1, DIM1 + allocate (x(i)%arr(DIM2)) + allocate (y(i)%arr(DIM2)) + do j = 1, DIM2 + x(i)%arr(j) = i * j + y(i)%arr(j) = i + j + exp = exp + x(i)%arr(j) * y(i)%arr(j) + end do + end do + + mkarrays = exp + end function + + integer function f (i, j) + integer, intent(in) :: i, j + + f = i * 4 + j + 1 + end function +end program