From patchwork Tue Sep 5 19:28:21 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830098 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=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 (ip-8-43-85-97.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 4RgFv75VWQz1yhH for ; Wed, 6 Sep 2023 05:29:39 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7C14538319CB for ; Tue, 5 Sep 2023 19:29:36 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id B9F743857BB3; Tue, 5 Sep 2023 19:29:03 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B9F743857BB3 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="6.02,229,1688457600"; d="scan'208";a="16179079" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:28:56 -0800 IronPort-SDR: yVhgIqpSQ9/TVoQ1zaJQLhzKIEhZcEjxCBy32Lr7TxN7zMIzYDQngkN3fUfWOU8M3T8iQoalRA DJz2nt/QYXBgOHAAHF4KVd3pJDIaPUniWY3zSs9vQ8c646wCCDGQj20JXgRJBJFOvf1va3YuHm aOn2iMGQ9GIyX8hJLQNJKb2s+5Wjrozkk9wW5aABYe2mdyp2zuaG7UIIfxQdHyzbzhNMbLQmgG o3uki/qMOZxNgrb595OovcT6OfetOiubyUnV/JS9JgTjJRjtEIzFJO34WKeek2xXJkkDreSp8o WDg= From: Julian Brown To: CC: , , Subject: [PATCH 1/8] OpenMP: lvalue parsing for map/to/from clauses (C++) Date: Tue, 5 Sep 2023 12:28:21 -0700 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: 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.8 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, 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 Sender: "Gcc-patches" This patch supports "lvalue" parsing (or "locator list item type" parsing) for several OpenMP clause types for C++, as required for OpenMP 5.0 and above. It is based on the version committed to the og13 branch, posted here: https://gcc.gnu.org/pipermail/gcc-patches/2023-June/623354.html which in turn was based on the last version posted upstream: https://gcc.gnu.org/pipermail/gcc-patches/2022-December/609040.html This version has mostly just been rebased. 2023-09-05 Julian Brown gcc/c-family/ * c-common.h (c_omp_address_inspector): Remove static from get_origin and maybe_unconvert_ref methods. * c-omp.cc (c_omp_split_clauses): Support OMP_ARRAY_SECTION. (c_omp_address_inspector::map_supported_p): Handle OMP_ARRAY_SECTION. (c_omp_address_inspector::get_origin): Avoid dereferencing possibly NULL type when processing template decls. (c_omp_address_inspector::maybe_unconvert_ref): Likewise. gcc/cp/ * constexpr.cc (potential_consant_expression_1): Handle OMP_ARRAY_SECTION. * cp-tree.h (grok_omp_array_section, build_omp_array_section): Add prototypes. * decl2.cc (grok_omp_array_section): New function. * error.cc (dump_expr): Handle OMP_ARRAY_SECTION. * parser.cc (cp_parser_new): Initialize parser->omp_array_section_p. (cp_parser_statement_expr): Disallow array sections. (cp_parser_postfix_open_square_expression): Support OMP_ARRAY_SECTION parsing. (cp_parser_parenthesized_expression_list, cp_parser_lambda_expression, cp_parser_braced_list): Disallow array sections. (cp_parser_omp_var_list_no_open): Remove ALLOW_DEREF parameter, add MAP_LVALUE in its place. Support generalised lvalue parsing for OpenMP map, to and from clauses. Use OMP_ARRAY_SECTION code instead of TREE_LIST to represent OpenMP array sections. (cp_parser_omp_var_list): Remove ALLOW_DEREF parameter, add MAP_LVALUE. Pass to cp_parser_omp_var_list_no_open. (cp_parser_oacc_data_clause): Update call to cp_parser_omp_var_list. (cp_parser_omp_clause_map): Add sk_omp scope around cp_parser_omp_var_list_no_open call. * parser.h (cp_parser): Add omp_array_section_p field. * pt.cc (tsubst, tsubst_copy, tsubst_omp_clause_decl, tsubst_copy_and_build): Add OMP_ARRAY_SECTION support. * semantics.cc (handle_omp_array_sections_1, handle_omp_array_sections, cp_oacc_check_attachments, finish_omp_clauses): Use OMP_ARRAY_SECTION instead of TREE_LIST where appropriate. Handle more types of map expression. * typeck.cc (build_omp_array_section): New function. gcc/ * gimplify.cc (gimplify_expr): Ensure OMP_ARRAY_SECTION has been processed out before gimplification. * tree-pretty-print.cc (dump_generic_node): Support OMP_ARRAY_SECTION. * tree.def (OMP_ARRAY_SECTION): New tree code. gcc/testsuite/ * c-c++-common/gomp/map-6.c: Update expected output. * g++.dg/gomp/array-section-1.C: New test. * g++.dg/gomp/array-section-2.C: New test. * g++.dg/gomp/bad-array-section-1.C: New test. * g++.dg/gomp/bad-array-section-2.C: New test. * g++.dg/gomp/bad-array-section-3.C: New test. * g++.dg/gomp/bad-array-section-4.C: New test. * g++.dg/gomp/bad-array-section-5.C: New test. * g++.dg/gomp/bad-array-section-6.C: New test. * g++.dg/gomp/bad-array-section-7.C: New test. * g++.dg/gomp/bad-array-section-8.C: New test. * g++.dg/gomp/bad-array-section-9.C: New test. * g++.dg/gomp/bad-array-section-10.C: New test. * g++.dg/gomp/bad-array-section-11.C: New test. * g++.dg/gomp/has_device_addr-non-lvalue-1.C: New test. * g++.dg/gomp/pr67522.C: Update expected output. * g++.dg/gomp/ind-base-3.C: New test. * g++.dg/gomp/map-assignment-1.C: New test. * g++.dg/gomp/map-inc-1.C: New test. * g++.dg/gomp/map-lvalue-ref-1.C: New test. * g++.dg/gomp/map-ptrmem-1.C: New test. * g++.dg/gomp/map-ptrmem-2.C: New test. * g++.dg/gomp/map-static-cast-lvalue-1.C: New test. * g++.dg/gomp/map-ternary-1.C: New test. * g++.dg/gomp/member-array-2.C: New test. libgomp/ * testsuite/libgomp.c++/baseptrs-4.C: Remove commented-out cases that now work. * testsuite/libgomp.c++/baseptrs-6.C: New test. * testsuite/libgomp.c++/ind-base-1.C: New test. * testsuite/libgomp.c++/ind-base-2.C: New test. * testsuite/libgomp.c++/lvalue-tofrom-1.C: New test. * testsuite/libgomp.c++/lvalue-tofrom-2.C: New test. * testsuite/libgomp.c++/map-comma-1.C: New test. * testsuite/libgomp.c++/map-rvalue-ref-1.C: New test. * testsuite/libgomp.c++/struct-ref-1.C: New test. * testsuite/libgomp.c-c++-common/array-field-1.c: New test. * testsuite/libgomp.c-c++-common/array-of-struct-1.c: New test. * testsuite/libgomp.c-c++-common/array-of-struct-2.c: New test. --- gcc/c-family/c-common.h | 4 +- gcc/c-family/c-omp.cc | 23 +- gcc/cp/constexpr.cc | 1 + gcc/cp/cp-tree.h | 2 + gcc/cp/decl2.cc | 45 + gcc/cp/error.cc | 9 + gcc/cp/parser.cc | 209 +- gcc/cp/parser.h | 3 + gcc/cp/pt.cc | 49 + gcc/cp/semantics.cc | 69 +- gcc/cp/typeck.cc | 50 + gcc/gimplify.cc | 3 + gcc/testsuite/c-c++-common/gomp/map-6.c | 4 +- gcc/testsuite/g++.dg/gomp/array-section-1.C | 38 + gcc/testsuite/g++.dg/gomp/array-section-2.C | 63 + .../g++.dg/gomp/bad-array-section-1.C | 35 + .../g++.dg/gomp/bad-array-section-10.C | 35 + .../g++.dg/gomp/bad-array-section-11.C | 36 + .../g++.dg/gomp/bad-array-section-2.C | 33 + .../g++.dg/gomp/bad-array-section-3.C | 28 + .../g++.dg/gomp/bad-array-section-4.C | 50 + .../g++.dg/gomp/bad-array-section-5.C | 50 + .../g++.dg/gomp/bad-array-section-6.C | 24 + .../g++.dg/gomp/bad-array-section-7.C | 36 + .../g++.dg/gomp/bad-array-section-8.C | 53 + .../g++.dg/gomp/bad-array-section-9.C | 39 + .../gomp/has_device_addr-non-lvalue-1.C | 36 + gcc/testsuite/g++.dg/gomp/ind-base-3.C | 37 + gcc/testsuite/g++.dg/gomp/map-assignment-1.C | 12 + gcc/testsuite/g++.dg/gomp/map-inc-1.C | 10 + gcc/testsuite/g++.dg/gomp/map-lvalue-ref-1.C | 19 + gcc/testsuite/g++.dg/gomp/map-ptrmem-1.C | 37 + gcc/testsuite/g++.dg/gomp/map-ptrmem-2.C | 40 + .../g++.dg/gomp/map-static-cast-lvalue-1.C | 17 + gcc/testsuite/g++.dg/gomp/map-ternary-1.C | 20 + gcc/testsuite/g++.dg/gomp/member-array-2.C | 91 + gcc/testsuite/g++.dg/gomp/pr67522.C | 2 +- gcc/tree-pretty-print.cc | 14 + gcc/tree.def | 3 + libgomp/testsuite/libgomp.c++/baseptrs-4.C | 26 +- libgomp/testsuite/libgomp.c++/baseptrs-6.C | 3199 +++++++++++++++++ libgomp/testsuite/libgomp.c++/ind-base-1.C | 162 + libgomp/testsuite/libgomp.c++/ind-base-2.C | 93 + .../testsuite/libgomp.c++/lvalue-tofrom-1.C | 75 + .../testsuite/libgomp.c++/lvalue-tofrom-2.C | 71 + libgomp/testsuite/libgomp.c++/map-comma-1.C | 15 + .../testsuite/libgomp.c++/map-rvalue-ref-1.C | 22 + libgomp/testsuite/libgomp.c++/struct-ref-1.C | 97 + .../libgomp.c-c++-common/array-field-1.c | 35 + .../libgomp.c-c++-common/array-of-struct-1.c | 65 + .../libgomp.c-c++-common/array-of-struct-2.c | 65 + 51 files changed, 5187 insertions(+), 67 deletions(-) create mode 100644 gcc/testsuite/g++.dg/gomp/array-section-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/array-section-2.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-10.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-11.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-2.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-3.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-4.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-5.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-6.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-7.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-8.C create mode 100644 gcc/testsuite/g++.dg/gomp/bad-array-section-9.C create mode 100644 gcc/testsuite/g++.dg/gomp/has_device_addr-non-lvalue-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/ind-base-3.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-assignment-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-inc-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-lvalue-ref-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-ptrmem-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-ptrmem-2.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-static-cast-lvalue-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/map-ternary-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/member-array-2.C create mode 100644 libgomp/testsuite/libgomp.c++/baseptrs-6.C create mode 100644 libgomp/testsuite/libgomp.c++/ind-base-1.C create mode 100644 libgomp/testsuite/libgomp.c++/ind-base-2.C create mode 100644 libgomp/testsuite/libgomp.c++/lvalue-tofrom-1.C create mode 100644 libgomp/testsuite/libgomp.c++/lvalue-tofrom-2.C create mode 100644 libgomp/testsuite/libgomp.c++/map-comma-1.C create mode 100644 libgomp/testsuite/libgomp.c++/map-rvalue-ref-1.C create mode 100644 libgomp/testsuite/libgomp.c++/struct-ref-1.C create mode 100644 libgomp/testsuite/libgomp.c-c++-common/array-field-1.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/array-of-struct-1.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/array-of-struct-2.c diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h index 68dddfb887ca..4d1a6b1db6b9 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -1371,8 +1371,8 @@ public: bool map_supported_p (); - static tree get_origin (tree); - static tree maybe_unconvert_ref (tree); + tree get_origin (tree); + tree maybe_unconvert_ref (tree); bool maybe_zero_length_array_section (tree); diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc index 2b173359e800..0d668925da11 100644 --- a/gcc/c-family/c-omp.cc +++ b/gcc/c-family/c-omp.cc @@ -2679,6 +2679,9 @@ c_omp_split_clauses (location_t loc, enum tree_code code, } else if (TREE_CODE (OMP_CLAUSE_DECL (c)) == TREE_LIST) { + /* TODO: This can go away once we transition all uses of + TREE_LIST for representing OMP array sections to + OMP_ARRAY_SECTION. */ tree t; for (t = OMP_CLAUSE_DECL (c); TREE_CODE (t) == TREE_LIST; t = TREE_CHAIN (t)) @@ -2687,6 +2690,17 @@ c_omp_split_clauses (location_t loc, enum tree_code code, bitmap_clear_bit (&allocate_head, DECL_UID (t)); break; } + else if (TREE_CODE (OMP_CLAUSE_DECL (c)) == OMP_ARRAY_SECTION) + { + tree t; + for (t = OMP_CLAUSE_DECL (c); + TREE_CODE (t) == OMP_ARRAY_SECTION; + t = TREE_OPERAND (t, 0)) + ; + if (DECL_P (t)) + bitmap_clear_bit (&allocate_head, DECL_UID (t)); + break; + } /* FALLTHRU */ case OMP_CLAUSE_PRIVATE: case OMP_CLAUSE_FIRSTPRIVATE: @@ -3228,6 +3242,7 @@ c_omp_address_inspector::map_supported_p () || TREE_CODE (t) == SAVE_EXPR || TREE_CODE (t) == POINTER_PLUS_EXPR || TREE_CODE (t) == NON_LVALUE_EXPR + || TREE_CODE (t) == OMP_ARRAY_SECTION || TREE_CODE (t) == NOP_EXPR) if (TREE_CODE (t) == COMPOUND_EXPR) t = TREE_OPERAND (t, 1); @@ -3257,7 +3272,8 @@ c_omp_address_inspector::get_origin (tree t) else if (TREE_CODE (t) == POINTER_PLUS_EXPR || TREE_CODE (t) == SAVE_EXPR) t = TREE_OPERAND (t, 0); - else if (TREE_CODE (t) == INDIRECT_REF + else if (!processing_template_decl_p () + && TREE_CODE (t) == INDIRECT_REF && TREE_CODE (TREE_TYPE (TREE_OPERAND (t, 0))) == REFERENCE_TYPE) t = TREE_OPERAND (t, 0); else @@ -3274,7 +3290,10 @@ c_omp_address_inspector::get_origin (tree t) tree c_omp_address_inspector::maybe_unconvert_ref (tree t) { - if (TREE_CODE (t) == INDIRECT_REF + /* Be careful not to dereference the type if we're processing a + template decl, else it might be NULL. */ + if (!processing_template_decl_p () + && TREE_CODE (t) == INDIRECT_REF && TREE_CODE (TREE_TYPE (TREE_OPERAND (t, 0))) == REFERENCE_TYPE) return TREE_OPERAND (t, 0); diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc index da2c31168105..6eae8a50207f 100644 --- a/gcc/cp/constexpr.cc +++ b/gcc/cp/constexpr.cc @@ -9714,6 +9714,7 @@ potential_constant_expression_1 (tree t, bool want_rval, bool strict, bool now, case OACC_ENTER_DATA: case OACC_EXIT_DATA: case OACC_UPDATE: + case OMP_ARRAY_SECTION: /* GCC internal stuff. */ case VA_ARG_EXPR: case TRANSACTION_EXPR: diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index d051ee85f701..eaec574efbe8 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -6981,6 +6981,7 @@ extern void grokclassfn (tree, tree, enum overload_flags); extern tree grok_array_decl (location_t, tree, tree, vec **, tsubst_flags_t); +extern tree grok_omp_array_section (location_t, tree, tree, tree); extern tree delete_sanity (location_t, tree, tree, bool, int, tsubst_flags_t); extern tree check_classfn (tree, tree, tree); @@ -8085,6 +8086,7 @@ inline tree build_x_binary_op (const op_location_t &loc, } extern tree build_x_array_ref (location_t, tree, tree, tsubst_flags_t); +extern tree build_omp_array_section (location_t, tree, tree, tree); extern tree build_x_unary_op (location_t, enum tree_code, cp_expr, tree, tsubst_flags_t); diff --git a/gcc/cp/decl2.cc b/gcc/cp/decl2.cc index b402befba6da..2083d3b7b047 100644 --- a/gcc/cp/decl2.cc +++ b/gcc/cp/decl2.cc @@ -612,6 +612,51 @@ grok_array_decl (location_t loc, tree array_expr, tree index_exp, return expr; } +/* Build an OMP_ARRAY_SECTION expression, handling usage in template + definitions, etc. */ + +tree +grok_omp_array_section (location_t loc, tree array_expr, tree index, + tree length) +{ + tree orig_array_expr = array_expr; + tree orig_index = index; + tree orig_length = length; + + if (error_operand_p (array_expr) + || error_operand_p (index) + || error_operand_p (length)) + return error_mark_node; + + if (processing_template_decl) + { + if (type_dependent_expression_p (array_expr) + || type_dependent_expression_p (index) + || type_dependent_expression_p (length)) + return build_min_nt_loc (loc, OMP_ARRAY_SECTION, array_expr, index, + length); + array_expr = build_non_dependent_expr (array_expr); + if (index) + index = build_non_dependent_expr (index); + if (length) + length = build_non_dependent_expr (length); + } + + index = fold_non_dependent_expr (index); + length = fold_non_dependent_expr (length); + + /* NOTE: We can pass through invalidly-typed index/length fields + here (e.g. if the user tries to use a floating-point index/length). + This is diagnosed later in semantics.cc:handle_omp_array_sections_1. */ + + tree expr = build_omp_array_section (loc, array_expr, index, length); + + if (processing_template_decl) + expr = build_min_non_dep (OMP_ARRAY_SECTION, expr, orig_array_expr, + orig_index, orig_length); + return expr; +} + /* Given the cast expression EXP, checking out its validity. Either return an error_mark_node if there was an unavoidable error, return a cast to void for trying to delete a pointer w/ the value 0, or return the diff --git a/gcc/cp/error.cc b/gcc/cp/error.cc index 8a5219a68a19..c3082d46dbfe 100644 --- a/gcc/cp/error.cc +++ b/gcc/cp/error.cc @@ -2499,6 +2499,15 @@ dump_expr (cxx_pretty_printer *pp, tree t, int flags) pp_cxx_right_bracket (pp); break; + case OMP_ARRAY_SECTION: + dump_expr (pp, TREE_OPERAND (t, 0), flags); + pp_cxx_left_bracket (pp); + dump_expr (pp, TREE_OPERAND (t, 1), flags); + pp_colon (pp); + dump_expr (pp, TREE_OPERAND (t, 2), flags); + pp_cxx_right_bracket (pp); + break; + case UNARY_PLUS_EXPR: dump_unary_op (pp, "+", t, flags); break; diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index de655055be21..2186d4a65f42 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -4345,6 +4345,9 @@ cp_parser_new (cp_lexer *lexer) parser->omp_declare_simd = NULL; parser->oacc_routine = NULL; + /* Disallow OpenMP array sections in expressions. */ + parser->omp_array_section_p = false; + /* Not declaring an implicit function template. */ parser->auto_is_implicit_function_template_parm_p = false; parser->fully_implicit_function_template_p = false; @@ -5329,6 +5332,7 @@ static cp_expr cp_parser_statement_expr (cp_parser *parser) { cp_token_position start = cp_parser_start_tentative_firewall (parser); + auto oas = make_temp_override (parser->omp_array_section_p, false); /* Consume the '('. */ location_t start_loc = cp_lexer_peek_token (parser->lexer)->location; @@ -8147,6 +8151,7 @@ cp_parser_postfix_open_square_expression (cp_parser *parser, releasing_vec expression_list = NULL; location_t loc = cp_lexer_peek_token (parser->lexer)->location; bool saved_greater_than_is_operator_p; + bool saved_colon_corrects_to_scope_p; /* Consume the `[' token. */ cp_lexer_consume_token (parser->lexer); @@ -8154,6 +8159,10 @@ cp_parser_postfix_open_square_expression (cp_parser *parser, saved_greater_than_is_operator_p = parser->greater_than_is_operator_p; parser->greater_than_is_operator_p = true; + saved_colon_corrects_to_scope_p = parser->colon_corrects_to_scope_p; + if (parser->omp_array_section_p) + parser->colon_corrects_to_scope_p = false; + /* Parse the index expression. */ /* ??? For offsetof, there is a question of what to allow here. If offsetof is not being used in an integral constant expression context, @@ -8164,7 +8173,8 @@ cp_parser_postfix_open_square_expression (cp_parser *parser, constant expressions here. */ if (for_offsetof) index = cp_parser_constant_expression (parser); - else + else if (!parser->omp_array_section_p + || cp_lexer_next_token_is_not (parser->lexer, CPP_COLON)) { if (cxx_dialect >= cxx23 && cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_SQUARE)) @@ -8220,6 +8230,68 @@ cp_parser_postfix_open_square_expression (cp_parser *parser, parser->greater_than_is_operator_p = saved_greater_than_is_operator_p; + if (cxx_dialect >= cxx23 + && parser->omp_array_section_p + && expression_list.get () != NULL + && vec_safe_length (expression_list) > 1) + { + error_at (loc, "cannot use multidimensional subscript in OpenMP array " + "section"); + index = error_mark_node; + } + if (parser->omp_array_section_p + && cp_lexer_next_token_is (parser->lexer, CPP_COLON)) + { + cp_lexer_consume_token (parser->lexer); + tree length = NULL_TREE; + if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_SQUARE)) + { + if (cxx_dialect >= cxx23) + { + cp_expr expr + = cp_parser_parenthesized_expression_list_elt (parser, + /*cast_p=*/ + false, + /*allow_exp_p=*/ + true, + /*non_cst_p=*/ + NULL); + + if (expr == error_mark_node) + length = error_mark_node; + else + length = expr.get_value (); + + if (cp_lexer_next_token_is (parser->lexer, CPP_COMMA)) + { + error_at (loc, "cannot use multidimensional subscript in " + "OpenMP array section"); + length = error_mark_node; + } + } + else + length + = cp_parser_expression (parser, NULL, /*cast_p=*/false, + /*decltype_p=*/false, + /*warn_comma_p=*/warn_comma_subscript); + } + + parser->colon_corrects_to_scope_p = saved_colon_corrects_to_scope_p; + + if (index == error_mark_node || length == error_mark_node) + { + cp_parser_skip_to_closing_square_bracket (parser); + return error_mark_node; + } + else + cp_parser_require (parser, CPP_CLOSE_SQUARE, RT_CLOSE_SQUARE); + + return grok_omp_array_section (input_location, postfix_expression, index, + length); + } + + parser->colon_corrects_to_scope_p = saved_colon_corrects_to_scope_p; + /* Look for the closing `]'. */ cp_parser_require (parser, CPP_CLOSE_SQUARE, RT_CLOSE_SQUARE); @@ -8548,6 +8620,7 @@ cp_parser_parenthesized_expression_list (cp_parser* parser, { vec *expression_list; bool saved_greater_than_is_operator_p; + bool saved_omp_array_section_p; /* Assume all the expressions will be constant. */ if (non_constant_p) @@ -8565,6 +8638,9 @@ cp_parser_parenthesized_expression_list (cp_parser* parser, = parser->greater_than_is_operator_p; parser->greater_than_is_operator_p = true; + saved_omp_array_section_p = parser->omp_array_section_p; + parser->omp_array_section_p = false; + cp_expr expr (NULL_TREE); /* Consume expressions until there are no more. */ @@ -8629,12 +8705,14 @@ cp_parser_parenthesized_expression_list (cp_parser* parser, { parser->greater_than_is_operator_p = saved_greater_than_is_operator_p; + parser->omp_array_section_p = saved_omp_array_section_p; return NULL; } } parser->greater_than_is_operator_p = saved_greater_than_is_operator_p; + parser->omp_array_section_p = saved_omp_array_section_p; return expression_list; } @@ -11158,6 +11236,7 @@ cp_parser_lambda_expression (cp_parser* parser) cp_binding_level* implicit_template_scope = parser->implicit_template_scope; bool auto_is_implicit_function_template_parm_p = parser->auto_is_implicit_function_template_parm_p; + bool saved_omp_array_section_p = parser->omp_array_section_p; parser->num_template_parameter_lists = 0; parser->in_statement = 0; @@ -11166,6 +11245,7 @@ cp_parser_lambda_expression (cp_parser* parser) parser->implicit_template_parms = 0; parser->implicit_template_scope = 0; parser->auto_is_implicit_function_template_parm_p = false; + parser->omp_array_section_p = false; /* The body of a lambda in a discarded statement is not discarded. */ bool discarded = in_discarded_stmt; @@ -11216,6 +11296,7 @@ cp_parser_lambda_expression (cp_parser* parser) parser->implicit_template_scope = implicit_template_scope; parser->auto_is_implicit_function_template_parm_p = auto_is_implicit_function_template_parm_p; + parser->omp_array_section_p = saved_omp_array_section_p; } /* This field is only used during parsing of the lambda. */ @@ -25548,6 +25629,7 @@ cp_parser_braced_list (cp_parser *parser, bool *non_constant_p /*=nullptr*/) { tree initializer; location_t start_loc = cp_lexer_peek_token (parser->lexer)->location; + auto oas = make_temp_override (parser->omp_array_section_p, false); /* Consume the `{' token. */ matching_braces braces; @@ -37457,7 +37539,7 @@ struct omp_dim static tree cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, tree list, bool *colon, - bool allow_deref = false) + bool map_lvalue = false) { auto_vec dims; bool array_section_p; @@ -37474,6 +37556,105 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) cp_parser_parse_tentatively (parser); + /* This condition doesn't include OMP_CLAUSE_DEPEND or + OMP_CLAUSE_AFFINITY since lvalue ("locator list") parsing for those is + handled further down the function. */ + else if (map_lvalue + && (kind == OMP_CLAUSE_MAP + || kind == OMP_CLAUSE_TO + || kind == OMP_CLAUSE_FROM)) + { + auto s = make_temp_override (parser->omp_array_section_p, true); + token = cp_lexer_peek_token (parser->lexer); + location_t loc = token->location; + decl = cp_parser_assignment_expression (parser); + + /* This code rewrites a parsed expression containing various tree + codes used to represent array accesses into a more uniform nest of + OMP_ARRAY_SECTION nodes before it is processed by + semantics.cc:handle_omp_array_sections_1. It might be more + efficient to move this logic to that function instead, analysing + the parsed expression directly rather than this preprocessed + form. */ + dims.truncate (0); + if (TREE_CODE (decl) == OMP_ARRAY_SECTION) + { + while (TREE_CODE (decl) == OMP_ARRAY_SECTION) + { + tree low_bound = TREE_OPERAND (decl, 1); + tree length = TREE_OPERAND (decl, 2); + dims.safe_push (omp_dim (low_bound, length, loc, false)); + decl = TREE_OPERAND (decl, 0); + } + + while (TREE_CODE (decl) == ARRAY_REF + || TREE_CODE (decl) == INDIRECT_REF + || TREE_CODE (decl) == COMPOUND_EXPR) + { + if (REFERENCE_REF_P (decl)) + break; + + if (TREE_CODE (decl) == COMPOUND_EXPR) + { + decl = TREE_OPERAND (decl, 1); + STRIP_NOPS (decl); + } + else if (TREE_CODE (decl) == INDIRECT_REF) + { + dims.safe_push (omp_dim (integer_zero_node, + integer_one_node, loc, true)); + decl = TREE_OPERAND (decl, 0); + } + else /* ARRAY_REF. */ + { + tree index = TREE_OPERAND (decl, 1); + dims.safe_push (omp_dim (index, integer_one_node, loc, + true)); + decl = TREE_OPERAND (decl, 0); + } + } + + /* Bare references have their own special handling, so remove + the explicit dereference added by convert_from_reference. */ + if (REFERENCE_REF_P (decl)) + decl = TREE_OPERAND (decl, 0); + + for (int i = dims.length () - 1; i >= 0; i--) + decl = grok_omp_array_section (loc, decl, dims[i].low_bound, + dims[i].length); + } + else if (TREE_CODE (decl) == INDIRECT_REF) + { + bool ref_p = REFERENCE_REF_P (decl); + + /* Turn *foo into foo[0:1]. */ + decl = TREE_OPERAND (decl, 0); + STRIP_NOPS (decl); + + /* If we have "*foo" and + - it's an indirection of a reference, "unconvert" it, i.e. + strip the indirection (to just "foo"). + - it's an indirection of a pointer, turn it into + "foo[0:1]". */ + if (!ref_p) + decl = grok_omp_array_section (loc, decl, integer_zero_node, + integer_one_node); + } + else if (TREE_CODE (decl) == ARRAY_REF) + { + tree idx = TREE_OPERAND (decl, 1); + + decl = TREE_OPERAND (decl, 0); + STRIP_NOPS (decl); + + decl = grok_omp_array_section (loc, decl, idx, integer_one_node); + } + else if (TREE_CODE (decl) == NON_LVALUE_EXPR + || CONVERT_EXPR_P (decl)) + decl = TREE_OPERAND (decl, 0); + + goto build_clause; + } token = cp_lexer_peek_token (parser->lexer); if (kind != 0 && cp_parser_is_keyword (token, RID_THIS)) @@ -37552,8 +37733,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, case OMP_CLAUSE_TO: start_component_ref: while (cp_lexer_next_token_is (parser->lexer, CPP_DOT) - || (allow_deref - && cp_lexer_next_token_is (parser->lexer, CPP_DEREF))) + || cp_lexer_next_token_is (parser->lexer, CPP_DEREF)) { cpp_ttype ttype = cp_lexer_next_token_is (parser->lexer, CPP_DOT) @@ -37639,9 +37819,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, || kind == OMP_CLAUSE_TO) && !array_section_p && (cp_lexer_next_token_is (parser->lexer, CPP_DOT) - || (allow_deref - && cp_lexer_next_token_is (parser->lexer, - CPP_DEREF)))) + || cp_lexer_next_token_is (parser->lexer, CPP_DEREF))) { for (unsigned i = 0; i < dims.length (); i++) { @@ -37653,8 +37831,9 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, } else for (unsigned i = 0; i < dims.length (); i++) - decl = tree_cons (dims[i].low_bound, dims[i].length, decl); - + decl = build_omp_array_section (input_location, decl, + dims[i].low_bound, + dims[i].length); break; default: break; @@ -37675,6 +37854,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, cp_parser_parse_definitely (parser); } + build_clause: tree u = build_omp_clause (token->location, kind); OMP_CLAUSE_DECL (u) = decl; OMP_CLAUSE_CHAIN (u) = list; @@ -37724,11 +37904,11 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, static tree cp_parser_omp_var_list (cp_parser *parser, enum omp_clause_code kind, tree list, - bool allow_deref = false) + bool map_lvalue = false) { if (cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN)) return cp_parser_omp_var_list_no_open (parser, kind, list, NULL, - allow_deref); + map_lvalue); return list; } @@ -37795,7 +37975,7 @@ cp_parser_oacc_data_clause (cp_parser *parser, pragma_omp_clause c_kind, gcc_unreachable (); } tree nl, c; - nl = cp_parser_omp_var_list (parser, OMP_CLAUSE_MAP, list, true); + nl = cp_parser_omp_var_list (parser, OMP_CLAUSE_MAP, list, false); for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) OMP_CLAUSE_SET_MAP_KIND (c, kind); @@ -40684,8 +40864,13 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list) cp_lexer_consume_token (parser->lexer); } + /* We introduce a scope here so that errors parsing e.g. "always", "close" + tokens do not propagate to later directives that might use them + legally. */ + begin_scope (sk_omp, NULL); nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_MAP, list, NULL, true); + finish_scope (); for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c)) OMP_CLAUSE_SET_MAP_KIND (c, kind); diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h index e261d7e16e48..574a83f38340 100644 --- a/gcc/cp/parser.h +++ b/gcc/cp/parser.h @@ -407,6 +407,9 @@ struct GTY(()) cp_parser { /* TRUE if omp::directive or omp::sequence attributes may not appear. */ bool omp_attrs_forbidden_p; + /* TRUE if an OpenMP array section is allowed. */ + bool omp_array_section_p; + /* Tracks the function's template parameter list when declaring a function using generic type parameters. This is either a new chain in the case of a fully implicit function template or an extension of the function's existing diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index ec76ac35217c..68963d12b3d7 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -16751,6 +16751,7 @@ tsubst (tree t, tree args, tsubst_flags_t complain, tree in_decl) case CALL_EXPR: case ARRAY_REF: case SCOPE_REF: + case OMP_ARRAY_SECTION: /* We should use one of the expression tsubsts for these codes. */ gcc_unreachable (); @@ -17769,6 +17770,17 @@ tsubst_copy (tree t, tree args, tsubst_flags_t complain, tree in_decl) return build_nt (ARRAY_REF, op0, op1, NULL_TREE, NULL_TREE); } + case OMP_ARRAY_SECTION: + { + tree op0 = tsubst_copy (TREE_OPERAND (t, 0), args, complain, in_decl); + tree op1 = NULL_TREE, op2 = NULL_TREE; + if (TREE_OPERAND (t, 1)) + op1 = tsubst_copy (TREE_OPERAND (t, 1), args, complain, in_decl); + if (TREE_OPERAND (t, 2)) + op2 = tsubst_copy (TREE_OPERAND (t, 2), args, complain, in_decl); + return build_nt (OMP_ARRAY_SECTION, op0, op1, op2); + } + case CALL_EXPR: { int n = VL_EXP_OPERAND_LENGTH (t); @@ -18037,6 +18049,22 @@ tsubst_omp_clause_decl (tree decl, tree args, tsubst_flags_t complain, = OMP_CLAUSE_DOACROSS_SINK_NEGATIVE (decl); return ret; } + else if (TREE_CODE (decl) == OMP_ARRAY_SECTION) + { + tree low_bound + = tsubst_expr (TREE_OPERAND (decl, 1), args, complain, in_decl); + tree length = tsubst_expr (TREE_OPERAND (decl, 2), args, complain, + in_decl); + tree base = tsubst_omp_clause_decl (TREE_OPERAND (decl, 0), args, + complain, in_decl, NULL); + if (TREE_OPERAND (decl, 0) == base + && TREE_OPERAND (decl, 1) == low_bound + && TREE_OPERAND (decl, 2) == length) + return decl; + tree ret = build3 (OMP_ARRAY_SECTION, TREE_TYPE (base), base, low_bound, + length); + return ret; + } tree ret = tsubst_expr (decl, args, complain, in_decl); /* Undo convert_from_reference tsubst_expr could have called. */ if (decl @@ -20811,6 +20839,27 @@ tsubst_copy_and_build (tree t, RECUR (TREE_OPERAND (t, 1)), complain|decltype_flag)); + case OMP_ARRAY_SECTION: + { + tree op0 = RECUR (TREE_OPERAND (t, 0)); + tree op1 = NULL_TREE, op2 = NULL_TREE; + if (op0 == error_mark_node) + RETURN (error_mark_node); + if (TREE_OPERAND (t, 1)) + { + op1 = RECUR (TREE_OPERAND (t, 1)); + if (op1 == error_mark_node) + RETURN (error_mark_node); + } + if (TREE_OPERAND (t, 2)) + { + op2 = RECUR (TREE_OPERAND (t, 2)); + if (op2 == error_mark_node) + RETURN (error_mark_node); + } + RETURN (build_omp_array_section (EXPR_LOCATION (t), op0, op1, op2)); + } + case SIZEOF_EXPR: if (PACK_EXPANSION_P (TREE_OPERAND (t, 0)) || ARGUMENT_PACK_P (TREE_OPERAND (t, 0))) diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc index 30e85ed13c08..e182914266f3 100644 --- a/gcc/cp/semantics.cc +++ b/gcc/cp/semantics.cc @@ -5274,7 +5274,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, { tree ret, low_bound, length, type; bool openacc = (ort & C_ORT_ACC) != 0; - if (TREE_CODE (t) != TREE_LIST) + if (TREE_CODE (t) != OMP_ARRAY_SECTION) { if (error_operand_p (t)) return error_mark_node; @@ -5296,7 +5296,9 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, ret = t_refto; if (TREE_CODE (t) == FIELD_DECL) ret = finish_non_static_data_member (t, NULL_TREE, NULL_TREE); - else if (!VAR_P (t) && TREE_CODE (t) != PARM_DECL) + else if (!VAR_P (t) + && (openacc || !EXPR_P (t)) + && TREE_CODE (t) != PARM_DECL) { if (processing_template_decl && TREE_CODE (t) != OVERLOAD) return NULL_TREE; @@ -5329,16 +5331,16 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, && (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION) - && TREE_CODE (TREE_CHAIN (t)) == FIELD_DECL) - TREE_CHAIN (t) = omp_privatize_field (TREE_CHAIN (t), false); - ret = handle_omp_array_sections_1 (c, TREE_CHAIN (t), types, + && TREE_CODE (TREE_OPERAND (t, 0)) == FIELD_DECL) + TREE_OPERAND (t, 0) = omp_privatize_field (TREE_OPERAND (t, 0), false); + ret = handle_omp_array_sections_1 (c, TREE_OPERAND (t, 0), types, maybe_zero_len, first_non_one, ort); if (ret == error_mark_node || ret == NULL_TREE) return ret; type = TREE_TYPE (ret); - low_bound = TREE_PURPOSE (t); - length = TREE_VALUE (t); + low_bound = TREE_OPERAND (t, 1); + length = TREE_OPERAND (t, 2); if ((low_bound && type_dependent_expression_p (low_bound)) || (length && type_dependent_expression_p (length))) return NULL_TREE; @@ -5544,7 +5546,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, tree lb = cp_save_expr (low_bound); if (lb != low_bound) { - TREE_PURPOSE (t) = lb; + TREE_OPERAND (t, 1) = lb; low_bound = lb; } } @@ -5575,14 +5577,14 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, array-section-subscript, the array section could be non-contiguous. */ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND - && TREE_CODE (TREE_CHAIN (t)) == TREE_LIST) + && TREE_CODE (TREE_OPERAND (t, 0)) == OMP_ARRAY_SECTION) { /* If any prior dimension has a non-one length, then deem this array section as non-contiguous. */ - for (tree d = TREE_CHAIN (t); TREE_CODE (d) == TREE_LIST; - d = TREE_CHAIN (d)) + for (tree d = TREE_OPERAND (t, 0); TREE_CODE (d) == OMP_ARRAY_SECTION; + d = TREE_OPERAND (d, 0)) { - tree d_length = TREE_VALUE (d); + tree d_length = TREE_OPERAND (d, 2); if (d_length == NULL_TREE || !integer_onep (d_length)) { error_at (OMP_CLAUSE_LOCATION (c), @@ -5605,7 +5607,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, tree lb = cp_save_expr (low_bound); if (lb != low_bound) { - TREE_PURPOSE (t) = lb; + TREE_OPERAND (t, 1) = lb; low_bound = lb; } /* Temporarily disable -fstrong-eval-order for array reductions. @@ -5683,10 +5685,12 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort) return false; for (i = num, t = OMP_CLAUSE_DECL (c); i > 0; - t = TREE_CHAIN (t)) + t = TREE_OPERAND (t, 0)) { - tree low_bound = TREE_PURPOSE (t); - tree length = TREE_VALUE (t); + gcc_assert (TREE_CODE (t) == OMP_ARRAY_SECTION); + + tree low_bound = TREE_OPERAND (t, 1); + tree length = TREE_OPERAND (t, 2); i--; if (low_bound @@ -6795,8 +6799,8 @@ cp_oacc_check_attachments (tree c) tree t = OMP_CLAUSE_DECL (c); tree type; - while (TREE_CODE (t) == TREE_LIST) - t = TREE_CHAIN (t); + while (TREE_CODE (t) == OMP_ARRAY_SECTION) + t = TREE_OPERAND (t, 0); type = TREE_TYPE (t); @@ -6903,7 +6907,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) case OMP_CLAUSE_TASK_REDUCTION: field_ok = ((ort & C_ORT_OMP_DECLARE_SIMD) == C_ORT_OMP); t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { if (handle_omp_array_sections (c, ort)) { @@ -6919,10 +6923,10 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) remove = true; break; } - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { - while (TREE_CODE (t) == TREE_LIST) - t = TREE_CHAIN (t); + while (TREE_CODE (t) == OMP_ARRAY_SECTION) + t = TREE_OPERAND (t, 0); } else { @@ -7943,7 +7947,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) else last_iterators = NULL_TREE; - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { if (handle_omp_array_sections (c, ort)) remove = true; @@ -8103,7 +8107,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) auto_vec addr_tokens; t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { grp_start_p = pc; grp_sentinel = OMP_CLAUSE_CHAIN (c); @@ -8113,7 +8117,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) else { t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) != TREE_LIST + if (TREE_CODE (t) != OMP_ARRAY_SECTION && !type_dependent_expression_p (t) && !omp_mappable_type (TREE_TYPE (t))) { @@ -8294,7 +8298,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER - || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH)) + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH + || (!openacc && EXPR_P (t)))) break; if (DECL_P (t)) error_at (OMP_CLAUSE_LOCATION (c), @@ -8692,15 +8697,15 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) case OMP_CLAUSE_HAS_DEVICE_ADDR: t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { if (handle_omp_array_sections (c, ort)) remove = true; else { t = OMP_CLAUSE_DECL (c); - while (TREE_CODE (t) == TREE_LIST) - t = TREE_CHAIN (t); + while (TREE_CODE (t) == OMP_ARRAY_SECTION) + t = TREE_OPERAND (t, 0); while (INDIRECT_REF_P (t) || TREE_CODE (t) == ARRAY_REF) t = TREE_OPERAND (t, 0); @@ -9071,10 +9076,10 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) if (DECL_P (t)) bitmap_clear_bit (&aligned_head, DECL_UID (t)); } - else if (TREE_CODE (t) == TREE_LIST) + else if (TREE_CODE (t) == OMP_ARRAY_SECTION) { - while (TREE_CODE (t) == TREE_LIST) - t = TREE_CHAIN (t); + while (TREE_CODE (t) == OMP_ARRAY_SECTION) + t = TREE_OPERAND (t, 0); if (DECL_P (t)) bitmap_clear_bit (&aligned_head, DECL_UID (t)); t = OMP_CLAUSE_DECL (c); diff --git a/gcc/cp/typeck.cc b/gcc/cp/typeck.cc index d5c0c85ed51b..33c789ebc332 100644 --- a/gcc/cp/typeck.cc +++ b/gcc/cp/typeck.cc @@ -4786,6 +4786,56 @@ build_x_array_ref (location_t loc, tree arg1, tree arg2, return expr; } +/* Build an OpenMP array section reference, creating an exact type for the + resulting expression based on the element type and bounds if possible. If + we have variable bounds, create an incomplete array type for the result + instead. */ + +tree +build_omp_array_section (location_t loc, tree array_expr, tree index, + tree length) +{ + tree idxtype; + + /* If we know the integer bounds, create an index type with exact + low/high (or zero/length) bounds. Otherwise, create an incomplete + array type. (This mostly only affects diagnostics.) */ + if (index != NULL_TREE + && length != NULL_TREE + && TREE_CODE (index) == INTEGER_CST + && TREE_CODE (length) == INTEGER_CST) + { + tree low = fold_convert (sizetype, index); + tree high = fold_convert (sizetype, length); + high = size_binop (PLUS_EXPR, low, high); + high = size_binop (MINUS_EXPR, high, size_one_node); + idxtype = build_range_type (sizetype, low, high); + } + else if ((index == NULL_TREE || integer_zerop (index)) + && length != NULL_TREE + && TREE_CODE (length) == INTEGER_CST) + idxtype = build_index_type (length); + else + idxtype = NULL_TREE; + + tree type = TREE_TYPE (array_expr); + gcc_assert (type); + type = non_reference (type); + + tree sectype, eltype = TREE_TYPE (type); + + /* It's not an array or pointer type. Just reuse the type of the + original expression as the type of the array section (an error will be + raised anyway, later). */ + if (eltype == NULL_TREE) + sectype = TREE_TYPE (array_expr); + else + sectype = build_array_type (eltype, idxtype); + + return build3_loc (loc, OMP_ARRAY_SECTION, sectype, array_expr, index, + length); +} + /* Return whether OP is an expression of enum type cast to integer type. In C++ even unsigned enum types are cast to signed integer types. We do not want to issue warnings about comparisons between diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 1e32ad48b844..ffc487a3a483 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -17456,6 +17456,9 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p, case TREE_LIST: gcc_unreachable (); + case OMP_ARRAY_SECTION: + gcc_unreachable (); + case COMPOUND_EXPR: ret = gimplify_compound_expr (expr_p, pre_p, fallback != fb_none); break; diff --git a/gcc/testsuite/c-c++-common/gomp/map-6.c b/gcc/testsuite/c-c++-common/gomp/map-6.c index 5152d9d7c21a..014ed35ab415 100644 --- a/gcc/testsuite/c-c++-common/gomp/map-6.c +++ b/gcc/testsuite/c-c++-common/gomp/map-6.c @@ -30,12 +30,12 @@ foo (void) #pragma omp target map (close a) /* { dg-error "'close' undeclared" "" { target c } } */ - /* { dg-error "'close' has not been declared" "" { target c++ } .-1 } */ + /* { dg-error "'close' was not declared in this scope" "" { target c++ } .-1 } */ /* { dg-error "expected '\\)' before 'a'" "" { target *-*-* } .-2 } */ ; #pragma omp target map (always a) /* { dg-error "'always' undeclared" "" { target c } } */ - /* { dg-error "'always' has not been declared" "" { target c++ } .-1 } */ + /* { dg-error "'always' was not declared in this scope" "" { target c++ } .-1 } */ /* { dg-error "expected '\\)' before 'a'" "" { target *-*-* } .-2 } */ ; diff --git a/gcc/testsuite/g++.dg/gomp/array-section-1.C b/gcc/testsuite/g++.dg/gomp/array-section-1.C new file mode 100644 index 000000000000..023706b15c5f --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/array-section-1.C @@ -0,0 +1,38 @@ +// { dg-do compile } +// { dg-additional-options "-fdump-tree-original" } + +int x; + +template +void foo() +{ + int arr1[40]; +#pragma omp target map(arr1[x ? C : D]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[x ? C : D : D]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[1 : x ? C : D]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[1\] \[len: x != 0 \? [0-9]+ : [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: [0-9]+\]\)} "original" } } + { } +} + +int main() +{ + int arr1[40]; +#pragma omp target map(arr1[x ? 3 : 5]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[x ? 3 : 5 : 5]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[1 : x ? 3 : 5]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[1\] [len: x != 0 ? [0-9]+ : [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: [0-9]+\]\)} "original" } } + { } + + foo<3, 5> (); + + return 0; +} + diff --git a/gcc/testsuite/g++.dg/gomp/array-section-2.C b/gcc/testsuite/g++.dg/gomp/array-section-2.C new file mode 100644 index 000000000000..072108d1f894 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/array-section-2.C @@ -0,0 +1,63 @@ +// { dg-do compile } +// { dg-additional-options "-fdump-tree-original" } + +int x, y; + +class C { + int x, y; + +public: + int foo(); +}; + +int C::foo() +{ + int arr1[40]; + /* There is a parsing ambiguity here without the space. We don't try to + resolve that automatically (though maybe we could, in theory). */ +#pragma omp target map(arr1[::x: ::y]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: \(sizetype\) y \* [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[::x:]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: \(40 - \(sizetype\) SAVE_EXPR \) \* [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[: ::y]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[0\] \[len: \(sizetype\) y \* [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: 0\]\)} "original" } } + { } + return ::x + ::y; +} + +template +class Ct { + T x, y; + +public: + void foo(); +}; + +template +void Ct::foo() +{ + int arr1[40]; +#pragma omp target map(arr1[::x: ::y]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: \(sizetype\) y \* [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[::x:]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[SAVE_EXPR \] \[len: \(40 - \(sizetype\) SAVE_EXPR \) \* [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: \(long int\) &arr1\[SAVE_EXPR \] - \(long int\) &arr1\]\)} "original" } } + { } +#pragma omp target map(arr1[: ::y]) +// { dg-final { scan-tree-dump {map\(tofrom:arr1\[0\] \[len: \(sizetype\) y \* [0-9]+\]\) map\(firstprivate:arr1 \[pointer assign, bias: 0\]\)} "original" } } + { } +} + +int main() +{ + C c; + Ct ct; + + c.foo (); + ct.foo (); + + return 0; +} + diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-1.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-1.C new file mode 100644 index 000000000000..7e7e95802069 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-1.C @@ -0,0 +1,35 @@ +// { dg-do compile } + +int foo (int *ptr); + +template +T baz (T *ptr); + +template +void bar() +{ + T arr[20]; + +#pragma omp target map(baz(arr[3:5])) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {expected '\)' before ':' token} "" { target *-*-* } .-2 } +// { dg-error {expected '\)' before '\]' token} "" { target *-*-* } .-3 } +// { dg-error {expected an OpenMP clause before '\]' token} "" { target *-*-* } .-4 } + { } +} + +int main() +{ + int arr[20]; + // Reject array section as function argument. +#pragma omp target map(foo(arr[3:5])) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {expected '\)' before ':' token} "" { target *-*-* } .-2 } +// { dg-error {expected '\)' before '\]' token} "" { target *-*-* } .-3 } +// { dg-error {expected an OpenMP clause before '\]' token} "" { target *-*-* } .-4 } + { } + + bar (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-10.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-10.C new file mode 100644 index 000000000000..393b0fefe512 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-10.C @@ -0,0 +1,35 @@ +// { dg-do compile } + +template +void foo() +{ + int arr1[40]; +#pragma omp target map(arr1[4,C:]) +// { dg-warning "top-level comma expression in array subscript is deprecated" "" { target c++20_only } .-1 } + { } +#pragma omp target map(arr1[4,5:C,7]) +// { dg-warning "top-level comma expression in array subscript is deprecated" "" { target c++20_only } .-1 } + { } +#pragma omp target map(arr1[:8,C,10]) +// { dg-warning "top-level comma expression in array subscript is deprecated" "" { target c++20_only } .-1 } + { } +} + +int main() +{ + int arr1[40]; +#pragma omp target map(arr1[4,5:]) +// { dg-warning "top-level comma expression in array subscript is deprecated" "" { target c++20_only } .-1 } + { } +#pragma omp target map(arr1[4,5:6,7]) +// { dg-warning "top-level comma expression in array subscript is deprecated" "" { target c++20_only } .-1 } + { } +#pragma omp target map(arr1[:8,9,10]) +// { dg-warning "top-level comma expression in array subscript is deprecated" "" { target c++20_only } .-1 } + { } + + foo<6, 9> (); + + return 0; +} + diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-11.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-11.C new file mode 100644 index 000000000000..dea3b4428f07 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-11.C @@ -0,0 +1,36 @@ +// { dg-do compile } +// { dg-additional-options "-std=c++23" } + +template +void foo() +{ + int arr1[40]; +#pragma omp target map(arr1[4,C:]) +// { dg-error "cannot use multidimensional subscript in OpenMP array section" "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[4,5:C,7]) +// { dg-error "cannot use multidimensional subscript in OpenMP array section" "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[:8,C,10]) +// { dg-error "cannot use multidimensional subscript in OpenMP array section" "" { target *-*-* } .-1 } + { } +} + +int main() +{ + int arr1[40]; +#pragma omp target map(arr1[4,5:]) +// { dg-error "cannot use multidimensional subscript in OpenMP array section" "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[4,5:6,7]) +// { dg-error "cannot use multidimensional subscript in OpenMP array section" "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[:8,9,10]) +// { dg-error "cannot use multidimensional subscript in OpenMP array section" "" { target *-*-* } .-1 } + { } + + foo<6, 9> (); + + return 0; +} + diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-2.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-2.C new file mode 100644 index 000000000000..811d1fee5a0b --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-2.C @@ -0,0 +1,33 @@ +// { dg-do compile } +// { dg-additional-options "-std=c++11" } + +template +void foo() +{ + T arr[20]; + // Reject array section in lambda function. +#pragma omp target map([&](const int x) -> T* { return arr[0:x]; } (5)) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {invalid conversion from 'int' to 'int\*'} "" { target *-*-* } .-2 } +// { dg-error {expected ';' before ':' token} "" { target *-*-* } .-3 } +// { dg-error {expected primary-expression before ':' token} "" { target *-*-* } .-4 } +// { dg-message {sorry, unimplemented: unsupported map expression 'foo\(\)::\{arr\}.foo\(\)::\(5\)'} "" { target *-*-* } .-5 } + { } +} + +int main() +{ + int arr[20]; + // Reject array section in lambda function. +#pragma omp target map([&](const int x) -> int* { return arr[0:x]; } (5)) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {invalid conversion from 'int' to 'int\*'} "" { target *-*-* } .-2 } +// { dg-error {expected ';' before ':' token} "" { target *-*-* } .-3 } +// { dg-error {expected primary-expression before ':' token} "" { target *-*-* } .-4 } +// { dg-message {sorry, unimplemented: unsupported map expression 'main\(\)::\{arr\}.main\(\)::\(5\)'} "" { target *-*-* } .-5 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-3.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-3.C new file mode 100644 index 000000000000..d1f067af2e98 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-3.C @@ -0,0 +1,28 @@ +// { dg-do compile } + +template +void foo() +{ + T arr[20]; + // Reject array section in statement expression. +#pragma omp target map( ({ int x = 5; arr[0:x]; }) ) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {expected ';' before ':' token} "" { target *-*-* } .-2 } +// { dg-message {sorry, unimplemented: unsupported map expression '\(\{\.\.\.\}\)'} "" { target *-*-* } .-3 } + { } +} + +int main() +{ + int arr[20]; + // Reject array section in statement expression. +#pragma omp target map( ({ int x = 5; arr[0:x]; }) ) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {expected ';' before ':' token} "" { target *-*-* } .-2 } +// { dg-message {sorry, unimplemented: unsupported map expression '\(\{\.\.\.\}\)'} "" { target *-*-* } .-3 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-4.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-4.C new file mode 100644 index 000000000000..707c2c31cb2a --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-4.C @@ -0,0 +1,50 @@ +// { dg-do compile } + +template +struct St { + T *ptr; +}; + +template +void foo() +{ + T arr[20]; + + // Reject array section in compound initialiser. +#pragma omp target map( (struct St) { .ptr = (T *) arr[5:5] } ) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-error {expected primary-expression before 'struct'} "" { target *-*-* } .-2 } +// { dg-error {expected '\)' before 'struct'} "" { target *-*-* } .-3 } + { } + + // ...and this is unsupported too (probably not useful anyway). +#pragma omp target map( (struct St) { .ptr = &arr[5] } ) +// { dg-message {sorry, unimplemented: unsupported map expression 'St\{\(\& arr\[5\]\)\}'} "" { target *-*-* } .-1 } + { } +} + +struct S { + int *ptr; +}; + +int main() +{ + int arr[20]; + + // Reject array section in compound initialiser. +#pragma omp target map( (struct S) { .ptr = (int *) arr[5:5] } ) +// { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } +// { dg-warning {cast to pointer from integer of different size} "" { target *-*-* } .-2 } +// { dg-error {expected primary-expression before 'struct'} "" { target *-*-* } .-3 } +// { dg-error {expected '\)' before 'struct'} "" { target *-*-* } .-4 } + { } + + // ...and this is unsupported too (probably not useful anyway). +#pragma omp target map( (struct S) { .ptr = &arr[5] } ) +// { dg-message {sorry, unimplemented: unsupported map expression 'S\{\(\& arr\[5\]\)\}'} "" { target *-*-* } .-1 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-5.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-5.C new file mode 100644 index 000000000000..f9c27d48f0e3 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-5.C @@ -0,0 +1,50 @@ +// { dg-do compile } + +int x; + +template +void foo() +{ + T arr[20]; + T *ptr; + /* "arr[1:10]" looks like it might be an expression of array type, hence + able to be indexed (again). This isn't allowed, though. */ +#pragma omp target map(arr[1:10][2]) +// { dg-error {'arr\[1\]' does not have pointer or array type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr[1:x][2]) +// { dg-error {'arr\[1\]' does not have pointer or array type} "" { target *-*-* } .-1 } + { } + // ...and nor is this. +#pragma omp target map(ptr[1:10][2]) +// { dg-error {'\*\(ptr \+ [0-9]+\)' does not have pointer or array type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(ptr[1:x][2]) +// { dg-error {'\*\(ptr \+ [0-9]+\)' does not have pointer or array type} "" { target *-*-* } .-1 } + { } +} + +int main() +{ + int arr[20]; + int *ptr; + /* "arr[1:10]" looks like it might be an expression of array type, hence + able to be indexed (again). This isn't allowed, though. */ +#pragma omp target map(arr[1:10][2]) +// { dg-error {'arr\[1\]' does not have pointer or array type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr[1:x][2]) +// { dg-error {'arr\[1\]' does not have pointer or array type} "" { target *-*-* } .-1 } + { } + // ...and nor is this. +#pragma omp target map(ptr[1:10][2]) +// { dg-error {'\*\(ptr \+ [0-9]+\)' does not have pointer or array type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(ptr[1:x][2]) +// { dg-error {'\*\(ptr \+ [0-9]+\)' does not have pointer or array type} "" { target *-*-* } .-1 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-6.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-6.C new file mode 100644 index 000000000000..418ee80431f3 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-6.C @@ -0,0 +1,24 @@ +// { dg-do compile } + +bool partly = false; + +template +void foo() +{ + T arr[20]; +#pragma omp target map(partly ? arr[5:5] : arr) +// { dg-message {sorry, unimplemented: unsupported map expression '\(partly \? \(\(int\*\)\(\& arr\[5:5\]\)\) : \(\(int\*\)\(\& arr\)\)\)'} "" { target *-*-* } .-1 } + { } +} + +int main() +{ + int arr[20]; +#pragma omp target map(partly ? arr[5:5] : arr) +// { dg-message {sorry, unimplemented: unsupported map expression '\(partly \? \(\(int\*\)\(\& arr\[5:5\]\)\) : \(\(int\*\)\(\& arr\)\)\)'} "" { target *-*-* } .-1 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-7.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-7.C new file mode 100644 index 000000000000..24ac165e2bdb --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-7.C @@ -0,0 +1,36 @@ +// { dg-do compile } + +int x; + +template +void foo() +{ + T arr[20]; + // Here we know the type of the array section (the upper bound is reported)... +#pragma omp target map(arr[5:5] * 2) +// { dg-error {invalid operands of types 'int \[10\]' and 'int'} "" { target *-*-* } .-1 } + { } + /* ...but here, we have an incomplete array type because of the variable + low bound 'x'. */ +#pragma omp target map(arr[x:5] * 2) +// { dg-error {invalid operands of types 'int \[\]' and 'int'} "" { target *-*-* } .-1 } + { } +} + +int main() +{ + int arr[20]; + // Here we know the type of the array section (the upper bound is reported)... +#pragma omp target map(arr[5:5] * 2) +// { dg-error {invalid operands of types 'int \[10\]' and 'int'} "" { target *-*-* } .-1 } + { } + /* ...but here, we have an incomplete array type because of the variable + low bound 'x'. */ +#pragma omp target map(arr[x:5] * 2) +// { dg-error {invalid operands of types 'int \[\]' and 'int'} "" { target *-*-* } .-1 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-8.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-8.C new file mode 100644 index 000000000000..2353722a581d --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-8.C @@ -0,0 +1,53 @@ +// { dg-do compile } + +int x; + +template +struct Tt { + X arr[20]; +}; + +template +struct St { + X *tvec; +}; + +template +void foo() +{ + struct St > *s; + // You can't use an array section like this. Make sure sensible errors are + // reported. +#pragma omp target map(s->tvec[3:5].arr[0:20]) +// { dg-error {request for member 'arr' in 's->St >::tvec\[3:5\]', which is of non-class type 'Tt \[8\]'} "" { target *-*-* } .-1 } + { } +#pragma omp target map(s->tvec[5:x].arr[0:20]) +// { dg-error {invalid use of array with unspecified bounds} "" { target *-*-* } .-1 } + { } +} + +struct T { + int arr[20]; +}; + +struct S { + struct T *tvec; +}; + +int main() +{ + struct S *s; + // You can't use an array section like this. Make sure sensible errors are + // reported. +#pragma omp target map(s->tvec[3:5].arr[0:20]) +// { dg-error {request for member 'arr' in 's->S::tvec\[3:5\]', which is of non-class type 'T \[8\]'} "" { target *-*-* } .-1 } + { } +#pragma omp target map(s->tvec[5:x].arr[0:20]) +// { dg-error {invalid use of array with unspecified bounds} "" { target *-*-* } .-1 } +// { dg-error {expected '\)' before 'arr'} "" { target *-*-* } .-2 } + { } + + foo (); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-section-9.C b/gcc/testsuite/g++.dg/gomp/bad-array-section-9.C new file mode 100644 index 000000000000..bba7772a3c90 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/bad-array-section-9.C @@ -0,0 +1,39 @@ +// { dg-do compile } + +int x; + +template +void foo() +{ + T arr1[40]; + T arr2[40]; +#pragma omp target map(arr1[arr2[4:5]:arr2[6:7]]) +// { dg-error {low bound 'arr2\[4:5\]' of array section does not have integral type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[arr2[:1]:arr2[6:1]]) +// { dg-error {low bound 'arr2\[:1\]' of array section does not have integral type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[x:arr2[6:1]]) +// { dg-error {length 'arr2\[6:1\]' of array section does not have integral type} "" { target *-*-* } .-1 } + { } +} + +int main() +{ + int arr1[40]; + int arr2[40]; +#pragma omp target map(arr1[arr2[4:5]:arr2[6:7]]) +// { dg-error {low bound 'arr2\[4:5\]' of array section does not have integral type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[arr2[:1]:arr2[6:1]]) +// { dg-error {low bound 'arr2\[:1\]' of array section does not have integral type} "" { target *-*-* } .-1 } + { } +#pragma omp target map(arr1[x:arr2[6:1]]) +// { dg-error {length 'arr2\[6:1\]' of array section does not have integral type} "" { target *-*-* } .-1 } + { } + + foo (); + + return 0; +} + diff --git a/gcc/testsuite/g++.dg/gomp/has_device_addr-non-lvalue-1.C b/gcc/testsuite/g++.dg/gomp/has_device_addr-non-lvalue-1.C new file mode 100644 index 000000000000..3d778538d3ab --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/has_device_addr-non-lvalue-1.C @@ -0,0 +1,36 @@ +// { dg-do compile } + +#include +#include +#include + +typedef struct { + int arr[100]; +} S; + +int main() +{ + S *s = new S; + + memset (s->arr, '\0', sizeof s->arr); + +#pragma omp target enter data map(to: (*s).arr) + /* You can't do this, at least as of OpenMP 5.2. "has_device_addr" takes + a "variable list" item type + (OpenMP 5.2, "5.4.9 has_device_addr Clause"). */ +#pragma omp target has_device_addr((*s).arr[5:20]) +// { dg-error {expected unqualified-id before '\(' token} "" { target *-*-* } .-1 } + { + for (int i = 5; i < 25; i++) + s->arr[i] = i; + } + +#pragma omp target exit data map(from: (*s).arr) + + for (int i = 0; i < 100; i++) + assert (i >= 5 && i < 25 ? s->arr[i] == i : s->arr[i] == 0); + + delete s; + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/ind-base-3.C b/gcc/testsuite/g++.dg/gomp/ind-base-3.C new file mode 100644 index 000000000000..7695b1f907e1 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/ind-base-3.C @@ -0,0 +1,37 @@ +#include + +struct S { + int x[10]; +}; + +S * +choose (S *a, S *b, int c) +{ + if (c < 5) + return a; + else + return b; +} + +int main (int argc, char *argv[]) +{ + S a, b; + + for (int i = 0; i < 10; i++) + a.x[i] = b.x[i] = 0; + + for (int i = 0; i < 10; i++) + { +#pragma omp target map(choose(&a, &b, i)->x[:10]) +/* { dg-message {sorry, unimplemented: unsupported map expression 'choose\(\(& a\), \(& b\), i\)->S::x\[0\]'} "" { target *-*-* } .-1 } */ + for (int j = 0; j < 10; j++) + choose (&a, &b, i)->x[j]++; + } + + for (int i = 0; i < 10; i++) + assert (a.x[i] == 5 && b.x[i] == 5); + + return 0; +} + + diff --git a/gcc/testsuite/g++.dg/gomp/map-assignment-1.C b/gcc/testsuite/g++.dg/gomp/map-assignment-1.C new file mode 100644 index 000000000000..5979ec379f19 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-assignment-1.C @@ -0,0 +1,12 @@ +#include + +int main (int argc, char *argv[]) +{ + int a = 5, b = 2; +#pragma omp target map(a += b) + /* { dg-message {sorry, unimplemented: unsupported map expression '\(a = \(a \+ b\)\)'} "" { target *-*-* } .-1 } */ + { + a++; + } + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/map-inc-1.C b/gcc/testsuite/g++.dg/gomp/map-inc-1.C new file mode 100644 index 000000000000..b469a4bd5485 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-inc-1.C @@ -0,0 +1,10 @@ +int main (int argc, char *argv[]) +{ + int a = 5; +#pragma omp target map(++a) + /* { dg-message {sorry, unimplemented: unsupported map expression '\+\+ a'} "" { target *-*-* } .-1 } */ + { + a++; + } + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/map-lvalue-ref-1.C b/gcc/testsuite/g++.dg/gomp/map-lvalue-ref-1.C new file mode 100644 index 000000000000..d720d4318ae4 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-lvalue-ref-1.C @@ -0,0 +1,19 @@ +#include + +int glob = 10; + +int& foo () +{ + return glob; +} + +int main (int argc, char *argv[]) +{ +#pragma omp target map(foo()) + /* { dg-message {sorry, unimplemented: unsupported map expression 'foo\(\)'} "" { target *-*-* } .-1 } */ + { + foo()++; + } + assert (glob == 11); + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/map-ptrmem-1.C b/gcc/testsuite/g++.dg/gomp/map-ptrmem-1.C new file mode 100644 index 000000000000..c4023f59fc60 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-ptrmem-1.C @@ -0,0 +1,37 @@ +#include + +struct S { + int x; + int *ptr; +}; + +int +main (int argc, char *argv[]) +{ + S s; + int S::* xp = &S::x; + int* S::* ptrp = &S::ptr; + + s.ptr = new int[64]; + + s.*xp = 6; + for (int i = 0; i < 64; i++) + (s.*ptrp)[i] = i; + +#pragma omp target map(s.*xp, s.*ptrp, (s.*ptrp)[:64]) + /* { dg-message {sorry, unimplemented: pointer-to-member mapping '\*\(\*\(\(\(int\*\*\)\(& s\)\) \+ \(\(sizetype\)ptrp\)\)\)' not supported} "" { target *-*-* } .-1 } */ + /* { dg-message {sorry, unimplemented: pointer-to-member mapping '\*\(\(\(int\*\*\)\(& s\)\) \+ \(\(sizetype\)ptrp\)\)' not supported} "" { target *-*-* } .-2 } */ + /* { dg-message {sorry, unimplemented: pointer-to-member mapping '\*\(\(\(int\*\)\(& s\)\) \+ \(\(sizetype\)xp\)\)' not supported} "" { target *-*-* } .-3 } */ +#pragma omp teams distribute parallel for + for (int i = 0; i < 64; i++) + { + (s.*xp)++; + (s.*ptrp)[i]++; + } + + assert (s.*xp == 70); + for (int i = 0; i < 64; i++) + assert ((s.*ptrp)[i] == i + 1); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/map-ptrmem-2.C b/gcc/testsuite/g++.dg/gomp/map-ptrmem-2.C new file mode 100644 index 000000000000..fbf379da0eb2 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-ptrmem-2.C @@ -0,0 +1,40 @@ +#include + +struct S { + int x; + int *ptr; +}; + +int +main (int argc, char *argv[]) +{ + S *s = new S; + int S::* xp = &S::x; + int* S::* ptrp = &S::ptr; + + s->ptr = new int[64]; + + s->*xp = 4; + for (int i = 0; i < 64; i++) + (s->*ptrp)[i] = i; + +#pragma omp target map(s->*xp, s->*ptrp, (s->*ptrp)[:64]) + /* { dg-message {sorry, unimplemented: pointer-to-member mapping '\*\(\(\(int\*\*\)s\) \+ \(\(sizetype\)ptrp\)\)' not supported} "" { target *-*-* } .-1 } */ + /* { dg-message {sorry, unimplemented: pointer-to-member mapping '\*\(\(\(int\*\)s\) \+ \(\(sizetype\)xp\)\)' not supported} "" { target *-*-* } .-2 } */ + /* { dg-message {sorry, unimplemented: pointer-to-member mapping '\*\(\*\(\(\(int\*\*\)s\) \+ \(\(sizetype\)ptrp\)\)\)' not supported} "" { target *-*-* } .-3 } */ +#pragma omp teams distribute parallel for + for (int i = 0; i < 64; i++) + { + (s->*xp)++; + (s->*ptrp)[i]++; + } + + assert (s->*xp == 68); + for (int i = 0; i < 64; i++) + assert ((s->*ptrp)[i] == i + 1); + + delete s->ptr; + delete s; + + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/map-static-cast-lvalue-1.C b/gcc/testsuite/g++.dg/gomp/map-static-cast-lvalue-1.C new file mode 100644 index 000000000000..3af9668202cb --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-static-cast-lvalue-1.C @@ -0,0 +1,17 @@ +#include + +int foo (int x) +{ +#pragma omp target map(static_cast(x)) + /* { dg-message {sorry, unimplemented: unsupported map expression '& x'} "" { target *-*-* } .-1 } */ + { + x += 3; + } + return x; +} + +int main (int argc, char *argv[]) +{ + assert (foo (5) == 8); + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/map-ternary-1.C b/gcc/testsuite/g++.dg/gomp/map-ternary-1.C new file mode 100644 index 000000000000..7b365a909bbb --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/map-ternary-1.C @@ -0,0 +1,20 @@ +#include + +int foo (bool yesno) +{ + int x = 5, y = 7; +#pragma omp target map(yesno ? x : y) + /* { dg-message {sorry, unimplemented: unsupported map expression '\(yesno \? x : y\)'} "" { target *-*-* } .-1 } */ + { + x += 3; + y += 5; + } + return yesno ? x : y; +} + +int main (int argc, char *argv[]) +{ + assert (foo (true) == 8); + assert (foo (false) == 12); + return 0; +} diff --git a/gcc/testsuite/g++.dg/gomp/member-array-2.C b/gcc/testsuite/g++.dg/gomp/member-array-2.C new file mode 100644 index 000000000000..caf8ece42624 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/member-array-2.C @@ -0,0 +1,91 @@ +#include + +typedef int intarr100[100]; + +class C { + int arr[100]; + int *ptr; + +public: + C(); + ~C(); + void zero (); + void do_operation (); + void check (int, int); + intarr100 &get_arr () { return arr; } + int *get_ptr() { return ptr; } +}; + +C::C() +{ + ptr = new int[100]; + for (int i = 0; i < 100; i++) + arr[i] = 0; +} + +C::~C() +{ + delete ptr; +} + +void +C::zero () +{ + for (int i = 0; i < 100; i++) + arr[i] = ptr[i] = 0; +} + +void +C::do_operation () +{ +#pragma omp target map(arr, ptr, ptr[:100]) +#pragma omp teams distribute parallel for + for (int i = 0; i < 100; i++) + { + arr[i] = arr[i] + 3; + ptr[i] = ptr[i] + 5; + } +} + +void +C::check (int arrval, int ptrval) +{ + for (int i = 0; i < 100; i++) + { + assert (arr[i] == arrval); + assert (ptr[i] == ptrval); + } +} + +int +main (int argc, char *argv[]) +{ + C c; + + c.zero (); + c.do_operation (); + c.check (3, 5); + + /* It might sort of make sense to be able to do this, but we don't support + it for now. */ + #pragma omp target map(c.get_arr()[:100]) + /* { dg-message {sorry, unimplemented: unsupported map expression 'c\.C::get_arr\(\)\[0\]'} "" { target *-*-* } .-1 } */ + #pragma omp teams distribute parallel for + for (int i = 0; i < 100; i++) + c.get_arr()[i] += 2; + + c.check (5, 5); + + /* Same for this. */ + #pragma omp target map(c.get_ptr(), c.get_ptr()[:100]) + /* { dg-message {sorry, unimplemented: unsupported map expression 'c\.C::get_ptr\(\)'} "" { target *-*-* } .-1 } */ + /* { dg-message {sorry, unimplemented: unsupported map expression '\* c\.C::get_ptr\(\)'} "" { target *-*-* } .-2 } */ + #pragma omp teams distribute parallel for + for (int i = 0; i < 100; i++) + c.get_ptr()[i] += 3; + + c.check (5, 8); + + return 0; +} + diff --git a/gcc/testsuite/g++.dg/gomp/pr67522.C b/gcc/testsuite/g++.dg/gomp/pr67522.C index da8cb74d1fa2..4a901ba68c7a 100644 --- a/gcc/testsuite/g++.dg/gomp/pr67522.C +++ b/gcc/testsuite/g++.dg/gomp/pr67522.C @@ -12,7 +12,7 @@ foo (void) for (int i = 0; i < 16; i++) ; - #pragma omp target map (S[0:10]) // { dg-error "is not a variable in" } + #pragma omp target map (S[0:10]) // { dg-error "expected primary-expression before '\\\[' token" } ; #pragma omp task depend (inout: S[0:10]) // { dg-error "is not a variable in" } diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index 0c1d6722c5ca..b6c029c346ef 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -2577,6 +2577,20 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, } break; + case OMP_ARRAY_SECTION: + op0 = TREE_OPERAND (node, 0); + if (op_prio (op0) < op_prio (node)) + pp_left_paren (pp); + dump_generic_node (pp, op0, spc, flags, false); + if (op_prio (op0) < op_prio (node)) + pp_right_paren (pp); + pp_left_bracket (pp); + dump_generic_node (pp, TREE_OPERAND (node, 1), spc, flags, false); + pp_colon (pp); + dump_generic_node (pp, TREE_OPERAND (node, 2), spc, flags, false); + pp_right_bracket (pp); + break; + case CONSTRUCTOR: { unsigned HOST_WIDE_INT ix; diff --git a/gcc/tree.def b/gcc/tree.def index be94b7ece0a7..5b6b1bab9db6 100644 --- a/gcc/tree.def +++ b/gcc/tree.def @@ -1354,6 +1354,9 @@ DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2) /* OpenMP clauses. */ DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0) +/* An OpenMP array section. */ +DEFTREECODE (OMP_ARRAY_SECTION, "omp_array_section", tcc_expression, 3) + /* TRANSACTION_EXPR tree code. Operand 0: BODY: contains body of the transaction. */ DEFTREECODE (TRANSACTION_EXPR, "transaction_expr", tcc_expression, 1) diff --git a/libgomp/testsuite/libgomp.c++/baseptrs-4.C b/libgomp/testsuite/libgomp.c++/baseptrs-4.C index 196029ac1868..d5ca79c3344d 100644 --- a/libgomp/testsuite/libgomp.c++/baseptrs-4.C +++ b/libgomp/testsuite/libgomp.c++/baseptrs-4.C @@ -11,11 +11,9 @@ #define REF2PTR_DECL_BASE #define ARRAY_DECL_BASE -// Needs map clause "lvalue"-parsing support. -//#define REF2ARRAY_DECL_BASE +#define REF2ARRAY_DECL_BASE #define PTR_OFFSET_DECL_BASE -// Needs map clause "lvalue"-parsing support. -//#define REF2PTR_OFFSET_DECL_BASE +#define REF2PTR_OFFSET_DECL_BASE #define MAP_SECTIONS @@ -30,25 +28,21 @@ #define ARRAY_DECL_MEMBER_SLICE #define ARRAY_DECL_MEMBER_SLICE_BASEPTR -// Needs map clause "lvalue"-parsing support. -//#define REF2ARRAY_DECL_MEMBER_SLICE -//#define REF2ARRAY_DECL_MEMBER_SLICE_BASEPTR +#define REF2ARRAY_DECL_MEMBER_SLICE +#define REF2ARRAY_DECL_MEMBER_SLICE_BASEPTR #define PTR_OFFSET_DECL_MEMBER_SLICE #define PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR -// Needs map clause "lvalue"-parsing support. -//#define REF2PTR_OFFSET_DECL_MEMBER_SLICE -//#define REF2PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTR_OFFSET_DECL_MEMBER_SLICE +#define REF2PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR #define PTRARRAY_DECL_MEMBER_SLICE #define PTRARRAY_DECL_MEMBER_SLICE_BASEPTR -// Needs map clause "lvalue"-parsing support. -//#define REF2PTRARRAY_DECL_MEMBER_SLICE -//#define REF2PTRARRAY_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTRARRAY_DECL_MEMBER_SLICE +#define REF2PTRARRAY_DECL_MEMBER_SLICE_BASEPTR #define PTRPTR_OFFSET_DECL_MEMBER_SLICE #define PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR -// Needs map clause "lvalue"-parsing support. -//#define REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE -//#define REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE +#define REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR #define NONREF_COMPONENT_BASE #define NONREF_COMPONENT_MEMBER_SLICE diff --git a/libgomp/testsuite/libgomp.c++/baseptrs-6.C b/libgomp/testsuite/libgomp.c++/baseptrs-6.C new file mode 100644 index 000000000000..0fc93d286645 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/baseptrs-6.C @@ -0,0 +1,3199 @@ +// { dg-do run } + +// This is essentially baseptrs-4.C with templates. + +#include +#include + +#define MAP_DECLS + +#define NONREF_DECL_BASE +#define REF_DECL_BASE +#define PTR_DECL_BASE +#define REF2PTR_DECL_BASE + +#define ARRAY_DECL_BASE +#define REF2ARRAY_DECL_BASE +#define PTR_OFFSET_DECL_BASE +#define REF2PTR_OFFSET_DECL_BASE + +#define MAP_SECTIONS + +#define NONREF_DECL_MEMBER_SLICE +#define NONREF_DECL_MEMBER_SLICE_BASEPTR +#define REF_DECL_MEMBER_SLICE +#define REF_DECL_MEMBER_SLICE_BASEPTR +#define PTR_DECL_MEMBER_SLICE +#define PTR_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTR_DECL_MEMBER_SLICE +#define REF2PTR_DECL_MEMBER_SLICE_BASEPTR + +#define ARRAY_DECL_MEMBER_SLICE +#define ARRAY_DECL_MEMBER_SLICE_BASEPTR +#define REF2ARRAY_DECL_MEMBER_SLICE +#define REF2ARRAY_DECL_MEMBER_SLICE_BASEPTR +#define PTR_OFFSET_DECL_MEMBER_SLICE +#define PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTR_OFFSET_DECL_MEMBER_SLICE +#define REF2PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR + +#define PTRARRAY_DECL_MEMBER_SLICE +#define PTRARRAY_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTRARRAY_DECL_MEMBER_SLICE +#define REF2PTRARRAY_DECL_MEMBER_SLICE_BASEPTR +#define PTRPTR_OFFSET_DECL_MEMBER_SLICE +#define PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +#define REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE +#define REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR + +#define NONREF_COMPONENT_BASE +#define NONREF_COMPONENT_MEMBER_SLICE +#define NONREF_COMPONENT_MEMBER_SLICE_BASEPTR + +#define REF_COMPONENT_BASE +#define REF_COMPONENT_MEMBER_SLICE +#define REF_COMPONENT_MEMBER_SLICE_BASEPTR + +#define PTR_COMPONENT_BASE +#define PTR_COMPONENT_MEMBER_SLICE +#define PTR_COMPONENT_MEMBER_SLICE_BASEPTR + +#define REF2PTR_COMPONENT_BASE +#define REF2PTR_COMPONENT_MEMBER_SLICE +#define REF2PTR_COMPONENT_MEMBER_SLICE_BASEPTR + +#ifdef MAP_DECLS +template +void +map_decls (void) +{ + int x = 0; + int &y = x; + int arr[4]; + int (&arrref)[N] = arr; + int *z = &arr[0]; + int *&t = z; + + memset (arr, 0, sizeof arr); + + #pragma omp target map(x) + { + x++; + } + + #pragma omp target map(y) + { + y++; + } + + assert (x == 2); + assert (y == 2); + + /* "A variable that is of type pointer is treated as if it is the base + pointer of a zero-length array section that appeared as a list item in a + map clause." */ + #pragma omp target map(z) + { + z++; + } + + /* "A variable that is of type reference to pointer is treated as if it had + appeared in a map clause as a zero-length array section." + + The pointer here is *not* associated with a target address, so we're not + disallowed from modifying it. */ + #pragma omp target map(t) + { + t++; + } + + assert (z == &arr[2]); + assert (t == &arr[2]); + + #pragma omp target map(arr) + { + arr[2]++; + } + + #pragma omp target map(arrref) + { + arrref[2]++; + } + + assert (arr[2] == 2); + assert (arrref[2] == 2); +} +#endif + +template +struct S { + T a; + T &b; + T *c; + T *&d; + T e[4]; + T (&f)[4]; + + S(T a1, T &b1, T *c1, T *&d1) : + a(a1), b(b1), c(c1), d(d1), f(e) + { + memset (e, 0, sizeof e); + } +}; + +#ifdef NONREF_DECL_BASE +template +void +nonref_decl_base (void) +{ + T a = 0, b = 0, c, *d = &c; + S mys(a, b, &c, d); + + #pragma omp target map(mys.a) + { + mys.a++; + } + + #pragma omp target map(mys.b) + { + mys.b++; + } + + assert (mys.a == 1); + assert (mys.b == 1); + + #pragma omp target map(mys.c) + { + mys.c++; + } + + #pragma omp target map(mys.d) + { + mys.d++; + } + + assert (mys.c == &c + 1); + assert (mys.d == &c + 1); + + #pragma omp target map(mys.e) + { + mys.e[0]++; + } + + #pragma omp target map(mys.f) + { + mys.f[0]++; + } + + assert (mys.e[0] == 2); + assert (mys.f[0] == 2); +} +#endif + +#ifdef REF_DECL_BASE +template +void +ref_decl_base (void) +{ + T a = 0, b = 0, c, *d = &c; + S mys_orig(a, b, &c, d); + S &mys = mys_orig; + + #pragma omp target map(mys.a) + { + mys.a++; + } + + #pragma omp target map(mys.b) + { + mys.b++; + } + + assert (mys.a == 1); + assert (mys.b == 1); + + #pragma omp target map(mys.c) + { + mys.c++; + } + + #pragma omp target map(mys.d) + { + mys.d++; + } + + assert (mys.c == &c + 1); + assert (mys.d == &c + 1); + + #pragma omp target map(mys.e) + { + mys.e[0]++; + } + + #pragma omp target map(mys.f) + { + mys.f[0]++; + } + + assert (mys.e[0] == 2); + assert (mys.f[0] == 2); +} +#endif + +#ifdef PTR_DECL_BASE +template +void +ptr_decl_base (void) +{ + A a = 0, b = 0, c, *d = &c; + S mys_orig(a, b, &c, d); + S *mys = &mys_orig; + + #pragma omp target map(mys->a) + { + mys->a++; + } + + #pragma omp target map(mys->b) + { + mys->b++; + } + + assert (mys->a == 1); + assert (mys->b == 1); + + #pragma omp target map(mys->c) + { + mys->c++; + } + + #pragma omp target map(mys->d) + { + mys->d++; + } + + assert (mys->c == &c + 1); + assert (mys->d == &c + 1); + + #pragma omp target map(mys->e) + { + mys->e[0]++; + } + + #pragma omp target map(mys->f) + { + mys->f[0]++; + } + + assert (mys->e[0] == 2); + assert (mys->f[0] == 2); +} +#endif + +#ifdef REF2PTR_DECL_BASE +template +void +ref2ptr_decl_base (void) +{ + A a = 0, b = 0, c, *d = &c; + S mys_orig(a, b, &c, d); + S *mysp = &mys_orig; + S *&mys = mysp; + + #pragma omp target map(mys->a) + { + mys->a++; + } + + #pragma omp target map(mys->b) + { + mys->b++; + } + + assert (mys->a == 1); + assert (mys->b == 1); + + #pragma omp target map(mys->c) + { + mys->c++; + } + + #pragma omp target map(mys->d) + { + mys->d++; + } + + assert (mys->c == &c + 1); + assert (mys->d == &c + 1); + + #pragma omp target map(mys->e) + { + mys->e[0]++; + } + + #pragma omp target map(mys->f) + { + mys->f[0]++; + } + + assert (mys->e[0] == 2); + assert (mys->f[0] == 2); +} +#endif + +#ifdef ARRAY_DECL_BASE +template +void +array_decl_base (void) +{ + A a = 0, b = 0, c, *d = &c; + S mys[4] = + { + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d) + }; + + #pragma omp target map(mys[2].a) + { + mys[2].a++; + } + + #pragma omp target map(mys[2].b) + { + mys[2].b++; + } + + assert (mys[2].a == 1); + assert (mys[2].b == 1); + + #pragma omp target map(mys[2].c) + { + mys[2].c++; + } + + #pragma omp target map(mys[2].d) + { + mys[2].d++; + } + + assert (mys[2].c == &c + 1); + assert (mys[2].d == &c + 1); + + #pragma omp target map(mys[2].e) + { + mys[2].e[0]++; + } + + #pragma omp target map(mys[2].f) + { + mys[2].f[0]++; + } + + assert (mys[2].e[0] == 2); + assert (mys[2].f[0] == 2); +} +#endif + +#ifdef REF2ARRAY_DECL_BASE +template +void +ref2array_decl_base (void) +{ + A a = 0, b = 0, c, *d = &c; + S mys_orig[4] = + { + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d) + }; + S (&mys)[4] = mys_orig; + + #pragma omp target map(mys[2].a) + { + mys[2].a++; + } + + #pragma omp target map(mys[2].b) + { + mys[2].b++; + } + + assert (mys[2].a == 1); + assert (mys[2].b == 1); + + #pragma omp target map(mys[2].c) + { + mys[2].c++; + } + + #pragma omp target map(mys[2].d) + { + mys[2].d++; + } + + assert (mys[2].c == &c + 1); + assert (mys[2].d == &c + 1); + + #pragma omp target map(mys[2].e) + { + mys[2].e[0]++; + } + + #pragma omp target map(mys[2].f) + { + mys[2].f[0]++; + } + + assert (mys[2].e[0] == 2); + assert (mys[2].f[0] == 2); +} +#endif + +#ifdef PTR_OFFSET_DECL_BASE +template +void +ptr_offset_decl_base (void) +{ + A a = 0, b = 0, c, *d = &c; + S mys_orig[4] = + { + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d) + }; + S *mys = &mys_orig[0]; + + #pragma omp target map(mys[2].a) + { + mys[2].a++; + } + + #pragma omp target map(mys[2].b) + { + mys[2].b++; + } + + assert (mys[2].a == 1); + assert (mys[2].b == 1); + + #pragma omp target map(mys[2].c) + { + mys[2].c++; + } + + #pragma omp target map(mys[2].d) + { + mys[2].d++; + } + + assert (mys[2].c == &c + 1); + assert (mys[2].d == &c + 1); + + #pragma omp target map(mys[2].e) + { + mys[2].e[0]++; + } + + #pragma omp target map(mys[2].f) + { + mys[2].f[0]++; + } + + assert (mys[2].e[0] == 2); + assert (mys[2].f[0] == 2); +} +#endif + +#ifdef REF2PTR_OFFSET_DECL_BASE +template +void +ref2ptr_offset_decl_base (void) +{ + A a = 0, b = 0, c, *d = &c; + S mys_orig[4] = + { + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d), + S(a, b, &c, d) + }; + S *mys_ptr = &mys_orig[0]; + S *&mys = mys_ptr; + + #pragma omp target map(mys[2].a) + { + mys[2].a++; + } + + #pragma omp target map(mys[2].b) + { + mys[2].b++; + } + + assert (mys[2].a == 1); + assert (mys[2].b == 1); + + #pragma omp target map(mys[2].c) + { + mys[2].c++; + } + + #pragma omp target map(mys[2].d) + { + mys[2].d++; + } + + assert (mys[2].c == &c + 1); + assert (mys[2].d == &c + 1); + + #pragma omp target map(mys[2].e) + { + mys[2].e[0]++; + } + + #pragma omp target map(mys[2].f) + { + mys[2].f[0]++; + } + + assert (mys[2].e[0] == 2); + assert (mys[2].f[0] == 2); +} +#endif + +#ifdef MAP_SECTIONS +template +void +map_sections (void) +{ + A arr[B]; + A *ptr; + A (&arrref)[B] = arr; + A *&ptrref = ptr; + + ptr = new int[B]; + memset (ptr, 0, sizeof (int) * B); + memset (arr, 0, sizeof (int) * B); + + #pragma omp target map(arr[0:B]) + { + arr[2]++; + } + + #pragma omp target map(ptr[0:B]) + { + ptr[2]++; + } + + #pragma omp target map(arrref[0:B]) + { + arrref[2]++; + } + + #pragma omp target map(ptrref[0:B]) + { + ptrref[2]++; + } + + assert (arr[2] == 2); + assert (ptr[2] == 2); + + delete ptr; +} +#endif + +template +struct T { + A a[10]; + A (&b)[10]; + A *c; + A *&d; + + T(A (&b1)[10], A *c1, A *&d1) : b(b1), c(c1), d(d1) + { + memset (a, 0, sizeof a); + } +}; + +#ifdef NONREF_DECL_MEMBER_SLICE +template +void +nonref_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt(c, &c[0], d); + + memset (c, 0, sizeof c); + + #pragma omp target map(myt.a[0:B]) + { + myt.a[2]++; + } + + #pragma omp target map(myt.b[0:B]) + { + myt.b[2]++; + } + + #pragma omp target enter data map(to: myt.c) + + #pragma omp target map(myt.c[0:B]) + { + myt.c[2]++; + } + + #pragma omp target exit data map(release: myt.c) + + #pragma omp target enter data map(to: myt.d) + + #pragma omp target map(myt.d[0:B]) + { + myt.d[2]++; + } + + #pragma omp target exit data map(from: myt.d) + + assert (myt.a[2] == 1); + assert (myt.b[2] == 3); + assert (myt.c[2] == 3); + assert (myt.d[2] == 3); +} +#endif + +#ifdef NONREF_DECL_MEMBER_SLICE_BASEPTR +template +void +nonref_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt(c, &c[0], d); + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt.c) map(myt.c[0:B]) + { + myt.c[2]++; + } + + #pragma omp target map(to:myt.d) map(myt.d[0:B]) + { + myt.d[2]++; + } + + assert (myt.c[2] == 2); + assert (myt.d[2] == 2); +} +#endif + +#ifdef REF_DECL_MEMBER_SLICE +template +void +ref_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T &myt = myt_real; + + memset (c, 0, sizeof c); + + #pragma omp target map(myt.a[0:B]) + { + myt.a[2]++; + } + + #pragma omp target map(myt.b[0:B]) + { + myt.b[2]++; + } + + #pragma omp target enter data map(to: myt.c) + + #pragma omp target map(myt.c[0:B]) + { + myt.c[2]++; + } + + #pragma omp target exit data map(release: myt.c) + + #pragma omp target enter data map(to: myt.d) + + #pragma omp target map(myt.d[0:B]) + { + myt.d[2]++; + } + + #pragma omp target exit data map(release: myt.d) + + assert (myt.a[2] == 1); + assert (myt.b[2] == 3); + assert (myt.c[2] == 3); + assert (myt.d[2] == 3); +} +#endif + +#ifdef REF_DECL_MEMBER_SLICE_BASEPTR +template +void +ref_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T &myt = myt_real; + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt.c) map(myt.c[0:B]) + { + myt.c[2]++; + } + + #pragma omp target map(to:myt.d) map(myt.d[0:B]) + { + myt.d[2]++; + } + + assert (myt.c[2] == 2); + assert (myt.d[2] == 2); +} +#endif + +#ifdef PTR_DECL_MEMBER_SLICE +template +void +ptr_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt = &myt_real; + + memset (c, 0, sizeof c); + + #pragma omp target enter data map(to: myt) + + #pragma omp target map(myt->a[0:B]) + { + myt->a[2]++; + } + + #pragma omp target map(myt->b[0:B]) + { + myt->b[2]++; + } + + #pragma omp target enter data map(to: myt->c) + + #pragma omp target map(myt->c[0:B]) + { + myt->c[2]++; + } + + #pragma omp target exit data map(release: myt->c) + + #pragma omp target enter data map(to: myt->d) + + #pragma omp target map(myt->d[0:B]) + { + myt->d[2]++; + } + + #pragma omp target exit data map(release: myt, myt->d) + + assert (myt->a[2] == 1); + assert (myt->b[2] == 3); + assert (myt->c[2] == 3); + assert (myt->d[2] == 3); +} +#endif + +#ifdef PTR_DECL_MEMBER_SLICE_BASEPTR +template +void +ptr_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt = &myt_real; + + memset (c, 0, sizeof c); + + // These ones have an implicit firstprivate for 'myt'. + #pragma omp target map(to:myt->c) map(myt->c[0:B]) + { + myt->c[2]++; + } + + #pragma omp target map(to:myt->d) map(myt->d[0:B]) + { + myt->d[2]++; + } + + // These ones have an explicit "TO" mapping for 'myt'. + #pragma omp target map(to:myt) map(to:myt->c) map(myt->c[0:B]) + { + myt->c[2]++; + } + + #pragma omp target map(to:myt) map(to:myt->d) map(myt->d[0:B]) + { + myt->d[2]++; + } + + assert (myt->c[2] == 4); + assert (myt->d[2] == 4); +} +#endif + +#ifdef REF2PTR_DECL_MEMBER_SLICE +template +void +ref2ptr_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptr = &myt_real; + T *&myt = myt_ptr; + + memset (c, 0, sizeof c); + + #pragma omp target enter data map(to: myt) + + #pragma omp target map(myt->a[0:B]) + { + myt->a[2]++; + } + + #pragma omp target map(myt->b[0:B]) + { + myt->b[2]++; + } + + #pragma omp target enter data map(to: myt->c) + + #pragma omp target map(myt->c[0:B]) + { + myt->c[2]++; + } + + #pragma omp target exit data map(release: myt->c) + + #pragma omp target enter data map(to: myt->d) + + #pragma omp target map(myt->d[0:B]) + { + myt->d[2]++; + } + + #pragma omp target exit data map(from: myt, myt->d) + + assert (myt->a[2] == 1); + assert (myt->b[2] == 3); + assert (myt->c[2] == 3); + assert (myt->d[2] == 3); +} +#endif + +#ifdef REF2PTR_DECL_MEMBER_SLICE_BASEPTR +template +void +ref2ptr_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptr = &myt_real; + T *&myt = myt_ptr; + + memset (c, 0, sizeof c); + + // These ones have an implicit firstprivate for 'myt'. + #pragma omp target map(to:myt->c) map(myt->c[0:B]) + { + myt->c[2]++; + } + + #pragma omp target map(to:myt->d) map(myt->d[0:B]) + { + myt->d[2]++; + } + + // These ones have an explicit "TO" mapping for 'myt'. + #pragma omp target map(to:myt) map(to:myt->c) map(myt->c[0:B]) + { + myt->c[2]++; + } + + #pragma omp target map(to:myt) map(to:myt->d) map(myt->d[0:B]) + { + myt->d[2]++; + } + + assert (myt->c[2] == 4); + assert (myt->d[2] == 4); +} +#endif + +#ifdef ARRAY_DECL_MEMBER_SLICE +template +void +array_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + + memset (c, 0, sizeof c); + + #pragma omp target map(myt[2].a[0:B]) + { + myt[2].a[2]++; + } + + #pragma omp target map(myt[2].b[0:B]) + { + myt[2].b[2]++; + } + + #pragma omp target enter data map(to: myt[2].c) + + #pragma omp target map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target exit data map(release: myt[2].c) + + #pragma omp target enter data map(to: myt[2].d) + + #pragma omp target map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + #pragma omp target exit data map(release: myt[2].d) + + assert (myt[2].a[2] == 1); + assert (myt[2].b[2] == 3); + assert (myt[2].c[2] == 3); + assert (myt[2].d[2] == 3); +} +#endif + +#ifdef ARRAY_DECL_MEMBER_SLICE_BASEPTR +template +void +array_decl_member_slice_baseptr (void) +{ + A c[10]; + A *d = &c[0]; + T myt[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt[2].c) map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target map(to:myt[2].d) map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + assert (myt[2].c[2] == 2); + assert (myt[2].d[2] == 2); +} +#endif + +#ifdef REF2ARRAY_DECL_MEMBER_SLICE +template +void +ref2array_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + T (&myt)[4] = myt_real; + + memset (c, 0, sizeof c); + + #pragma omp target map(myt[2].a[0:B]) + { + myt[2].a[2]++; + } + + #pragma omp target map(myt[2].b[0:B]) + { + myt[2].b[2]++; + } + + #pragma omp target enter data map(to: myt[2].c) + + #pragma omp target map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target exit data map(release: myt[2].c) + + #pragma omp target enter data map(to: myt[2].d) + + #pragma omp target map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + #pragma omp target exit data map(release: myt[2].d) + + assert (myt[2].a[2] == 1); + assert (myt[2].b[2] == 3); + assert (myt[2].c[2] == 3); + assert (myt[2].d[2] == 3); +} +#endif + +#ifdef REF2ARRAY_DECL_MEMBER_SLICE_BASEPTR +template +void +ref2array_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + T (&myt)[4] = myt_real; + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt[2].c) map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target map(to:myt[2].d) map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + assert (myt[2].c[2] == 2); + assert (myt[2].d[2] == 2); +} +#endif + +#ifdef PTR_OFFSET_DECL_MEMBER_SLICE +template +void +ptr_offset_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + T *myt = &myt_real[0]; + + memset (c, 0, sizeof c); + + #pragma omp target map(myt[2].a[0:B]) + { + myt[2].a[2]++; + } + + #pragma omp target map(myt[2].b[0:B]) + { + myt[2].b[2]++; + } + + #pragma omp target enter data map(to: myt[2].c) + + #pragma omp target map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target exit data map(release: myt[2].c) + + #pragma omp target enter data map(to: myt[2].d) + + #pragma omp target map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + #pragma omp target exit data map(release: myt[2].d) + + assert (myt[2].a[2] == 1); + assert (myt[2].b[2] == 3); + assert (myt[2].c[2] == 3); + assert (myt[2].d[2] == 3); +} +#endif + +#ifdef PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +template +void +ptr_offset_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + T *myt = &myt_real[0]; + + memset (c, 0, sizeof c); + + /* Implicit 'myt'. */ + #pragma omp target map(to:myt[2].c) map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target map(to:myt[2].d) map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + /* Explicit 'to'-mapped 'myt'. */ + #pragma omp target map(to:myt) map(to:myt[2].c) map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target map(to:myt) map(to:myt[2].d) map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + assert (myt[2].c[2] == 4); + assert (myt[2].d[2] == 4); +} +#endif + +#ifdef REF2PTR_OFFSET_DECL_MEMBER_SLICE +template +void +ref2ptr_offset_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + T *myt_ptr = &myt_real[0]; + T *&myt = myt_ptr; + + memset (c, 0, sizeof c); + + #pragma omp target map(myt[2].a[0:B]) + { + myt[2].a[2]++; + } + + #pragma omp target map(myt[2].b[0:B]) + { + myt[2].b[2]++; + } + + #pragma omp target enter data map(to: myt[2].c) + + #pragma omp target map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target exit data map(release: myt[2].c) + + #pragma omp target enter data map(to: myt[2].d) + + #pragma omp target map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + #pragma omp target exit data map(release: myt[2].d) + + assert (myt[2].a[2] == 1); + assert (myt[2].b[2] == 3); + assert (myt[2].c[2] == 3); + assert (myt[2].d[2] == 3); +} +#endif + +#ifdef REF2PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +template +void +ref2ptr_offset_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real[4] = + { + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d), + T (c, &c[0], d) + }; + T *myt_ptr = &myt_real[0]; + T *&myt = myt_ptr; + + memset (c, 0, sizeof c); + + /* Implicit 'myt'. */ + #pragma omp target map(to:myt[2].c) map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target map(to:myt[2].d) map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + /* Explicit 'to'-mapped 'myt'. */ + #pragma omp target map(to:myt) map(to:myt[2].c) map(myt[2].c[0:B]) + { + myt[2].c[2]++; + } + + #pragma omp target map(to:myt) map(to:myt[2].d) map(myt[2].d[0:B]) + { + myt[2].d[2]++; + } + + assert (myt[2].c[2] == 4); + assert (myt[2].d[2] == 4); +} +#endif + +#ifdef PTRARRAY_DECL_MEMBER_SLICE +template +void +ptrarray_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt[4] = + { + &myt_real, + &myt_real, + &myt_real, + &myt_real + }; + + memset (c, 0, sizeof c); + + #pragma omp target enter data map(to: myt[2]) + + #pragma omp target map(myt[2]->a[0:B]) + { + myt[2]->a[2]++; + } + + #pragma omp target map(myt[2]->b[0:B]) + { + myt[2]->b[2]++; + } + + #pragma omp target enter data map(to: myt[2]->c) + + #pragma omp target map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target exit data map(from: myt[2]->c) + + #pragma omp target enter data map(to: myt[2]->d) + + #pragma omp target map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + #pragma omp target exit data map(from: myt[2]->d) + + #pragma omp target exit data map(release: myt[2]) + + assert (myt[2]->a[2] == 1); + assert (myt[2]->b[2] == 3); + assert (myt[2]->c[2] == 3); + assert (myt[2]->d[2] == 3); +} +#endif + +#ifdef PTRARRAY_DECL_MEMBER_SLICE_BASEPTR +template +void +ptrarray_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt[4] = + { + &myt_real, + &myt_real, + &myt_real, + &myt_real + }; + + memset (c, 0, sizeof c); + + // Implicit 'myt' + #pragma omp target map(to: myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to: myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + // One element of 'myt' + #pragma omp target map(to:myt[2], myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt[2], myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + // Explicit map of all of 'myt' + #pragma omp target map(to:myt, myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt, myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + // Explicit map slice of 'myt' + #pragma omp target map(to:myt[1:3], myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt[1:3], myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + assert (myt[2]->c[2] == 8); + assert (myt[2]->d[2] == 8); +} +#endif + +#ifdef REF2PTRARRAY_DECL_MEMBER_SLICE +template +void +ref2ptrarray_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptrarr[4] = + { + &myt_real, + &myt_real, + &myt_real, + &myt_real + }; + T *(&myt)[4] = myt_ptrarr; + + memset (c, 0, sizeof c); + + #pragma omp target enter data map(to: myt[2]) + + #pragma omp target map(myt[2]->a[0:B]) + { + myt[2]->a[2]++; + } + + #pragma omp target map(myt[2]->b[0:B]) + { + myt[2]->b[2]++; + } + + #pragma omp target enter data map(to: myt[2]->c) + + #pragma omp target map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target exit data map(release: myt[2]->c) + + #pragma omp target enter data map(to: myt[2]->d) + + #pragma omp target map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + #pragma omp target exit data map(release: myt[2]->d) + + #pragma omp target exit data map(release: myt[2]) + + assert (myt[2]->a[2] == 1); + assert (myt[2]->b[2] == 3); + assert (myt[2]->c[2] == 3); + assert (myt[2]->d[2] == 3); +} +#endif + +#ifdef REF2PTRARRAY_DECL_MEMBER_SLICE_BASEPTR +template +void +ref2ptrarray_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptrarr[4] = + { + &myt_real, + &myt_real, + &myt_real, + &myt_real + }; + T *(&myt)[4] = myt_ptrarr; + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt[2], myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt[2], myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + #pragma omp target map(to:myt, myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt, myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + assert (myt[2]->c[2] == 4); + assert (myt[2]->d[2] == 4); +} +#endif + +#ifdef PTRPTR_OFFSET_DECL_MEMBER_SLICE +template +void +ptrptr_offset_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptrarr[4] = + { + &myt_real, + &myt_real, + &myt_real, + &myt_real + }; + T **myt = &myt_ptrarr[0]; + + memset (c, 0, sizeof c); + + #pragma omp target enter data map(to: myt[0:3]) + + /* NOTE: For the implicit firstprivate 'myt' to work, the zeroth element of + myt[] must be mapped above -- otherwise the zero-length array section + lookup fails. */ + #pragma omp target map(myt[2]->a[0:B]) + { + myt[2]->a[2]++; + } + + #pragma omp target map(myt[2]->b[0:B]) + { + myt[2]->b[2]++; + } + + #pragma omp target enter data map(to: myt[2]->c) + + #pragma omp target map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target exit data map(from: myt[2]->c) + + #pragma omp target enter data map(to: myt[2]->d) + + #pragma omp target map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + #pragma omp target exit data map(from: myt[0:3], myt[2]->d) + + assert (myt[2]->a[2] == 1); + assert (myt[2]->b[2] == 3); + assert (myt[2]->c[2] == 3); + assert (myt[2]->d[2] == 3); +} +#endif + +#ifdef PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +template +void +ptrptr_offset_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptrarr[4] = + { + 0, + 0, + 0, + &myt_real + }; + T **myt = &myt_ptrarr[0]; + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt[3], myt[3]->c) map(myt[3]->c[0:B]) + { + myt[3]->c[2]++; + } + + #pragma omp target map(to:myt[3], myt[3]->d) map(myt[3]->d[0:B]) + { + myt[3]->d[2]++; + } + + #pragma omp target map(to:myt, myt[3], myt[3]->c) map(myt[3]->c[0:B]) + { + myt[3]->c[2]++; + } + + #pragma omp target map(to:myt, myt[3], myt[3]->d) map(myt[3]->d[0:B]) + { + myt[3]->d[2]++; + } + + assert (myt[3]->c[2] == 4); + assert (myt[3]->d[2] == 4); +} +#endif + +#ifdef REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE +template +void +ref2ptrptr_offset_decl_member_slice (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptrarr[4] = + { + 0, + 0, + &myt_real, + 0 + }; + T **myt_ptrptr = &myt_ptrarr[0]; + T **&myt = myt_ptrptr; + + memset (c, 0, sizeof c); + + #pragma omp target enter data map(to: myt[0:3]) + + #pragma omp target map(myt[2]->a[0:B]) + { + myt[2]->a[2]++; + } + + #pragma omp target map(myt[2]->b[0:B]) + { + myt[2]->b[2]++; + } + + #pragma omp target enter data map(to:myt[2]->c) + + #pragma omp target map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target exit data map(release:myt[2]->c) + + #pragma omp target enter data map(to:myt[2]->d) + + #pragma omp target map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + #pragma omp target exit data map(release: myt[0:3], myt[2]->d) + + assert (myt[2]->a[2] == 1); + assert (myt[2]->b[2] == 3); + assert (myt[2]->c[2] == 3); + assert (myt[2]->d[2] == 3); +} +#endif + +#ifdef REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR +template +void +ref2ptrptr_offset_decl_member_slice_baseptr (void) +{ + A c[B]; + A *d = &c[0]; + T myt_real(c, &c[0], d); + T *myt_ptrarr[4] = + { + 0, + 0, + &myt_real, + 0 + }; + T **myt_ptrptr = &myt_ptrarr[0]; + T **&myt = myt_ptrptr; + + memset (c, 0, sizeof c); + + #pragma omp target map(to:myt[2], myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt[2], myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + #pragma omp target map(to:myt, myt[2], myt[2]->c) map(myt[2]->c[0:B]) + { + myt[2]->c[2]++; + } + + #pragma omp target map(to:myt, myt[2], myt[2]->d) map(myt[2]->d[0:B]) + { + myt[2]->d[2]++; + } + + assert (myt[2]->c[2] == 4); + assert (myt[2]->d[2] == 4); +} +#endif + +template +struct U +{ + S s1; + T t1; + S &s2; + T &t2; + S *s3; + T *t3; + S *&s4; + T *&t4; + + U(S &sptr1, T &tptr1, S &sptr2, T &tptr2, + S *sptr3, T *tptr3, S *&sptr4, T *&tptr4) + : s1(sptr1), t1(tptr1), s2(sptr2), t2(tptr2), s3(sptr3), t3(tptr3), + s4(sptr4), t4(tptr4) + { + } +}; + +#define INIT_S(N) \ + A a##N = 0, b##N = 0, c##N = 0, d##N = 0; \ + A *d##N##ptr = &d##N; \ + S s##N(a##N, b##N, &c##N, d##N##ptr) + +#define INIT_T(N) \ + A arr##N[10]; \ + A *ptr##N = &arr##N[0]; \ + T t##N(arr##N, &arr##N[0], ptr##N); \ + memset (arr##N, 0, sizeof arr##N) + +#define INIT_ST \ + INIT_S(1); \ + INIT_T(1); \ + INIT_S(2); \ + INIT_T(2); \ + INIT_S(3); \ + INIT_T(3); \ + A a4 = 0, b4 = 0, c4 = 0, d4 = 0; \ + A *d4ptr = &d4; \ + S *s4 = new S(a4, b4, &c4, d4ptr); \ + A arr4[10]; \ + A *ptr4 = &arr4[0]; \ + T *t4 = new T(arr4, &arr4[0], ptr4); \ + memset (arr4, 0, sizeof arr4) + +#ifdef NONREF_COMPONENT_BASE +template +void +nonref_component_base (void) +{ + INIT_ST; + U myu(s1, t1, s2, t2, &s3, &t3, s4, t4); + + #pragma omp target map(myu.s1.a, myu.s1.b, myu.s1.c, myu.s1.d) + { + myu.s1.a++; + myu.s1.b++; + myu.s1.c++; + myu.s1.d++; + } + + assert (myu.s1.a == 1); + assert (myu.s1.b == 1); + assert (myu.s1.c == &c1 + 1); + assert (myu.s1.d == &d1 + 1); + + #pragma omp target map(myu.s2.a, myu.s2.b, myu.s2.c, myu.s2.d) + { + myu.s2.a++; + myu.s2.b++; + myu.s2.c++; + myu.s2.d++; + } + + assert (myu.s2.a == 1); + assert (myu.s2.b == 1); + assert (myu.s2.c == &c2 + 1); + assert (myu.s2.d == &d2 + 1); + + #pragma omp target map(to:myu.s3) \ + map(myu.s3->a, myu.s3->b, myu.s3->c, myu.s3->d) + { + myu.s3->a++; + myu.s3->b++; + myu.s3->c++; + myu.s3->d++; + } + + assert (myu.s3->a == 1); + assert (myu.s3->b == 1); + assert (myu.s3->c == &c3 + 1); + assert (myu.s3->d == &d3 + 1); + + #pragma omp target map(to:myu.s4) \ + map(myu.s4->a, myu.s4->b, myu.s4->c, myu.s4->d) + { + myu.s4->a++; + myu.s4->b++; + myu.s4->c++; + myu.s4->d++; + } + + assert (myu.s4->a == 1); + assert (myu.s4->b == 1); + assert (myu.s4->c == &c4 + 1); + assert (myu.s4->d == &d4 + 1); + + delete s4; + delete t4; +} +#endif + +#ifdef NONREF_COMPONENT_MEMBER_SLICE +template +void +nonref_component_member_slice (void) +{ + INIT_ST; + U myu(s1, t1, s2, t2, &s3, &t3, s4, t4); + + #pragma omp target map(myu.t1.a[2:5]) + { + myu.t1.a[2]++; + } + + #pragma omp target map(myu.t1.b[2:5]) + { + myu.t1.b[2]++; + } + + #pragma omp target enter data map(to: myu.t1.c) + + #pragma omp target map(myu.t1.c[2:5]) + { + myu.t1.c[2]++; + } + + #pragma omp target exit data map(release: myu.t1.c) + + #pragma omp target enter data map(to: myu.t1.d) + + #pragma omp target map(myu.t1.d[2:5]) + { + myu.t1.d[2]++; + } + + #pragma omp target exit data map(from: myu.t1.d) + + assert (myu.t1.a[2] == 1); + assert (myu.t1.b[2] == 3); + assert (myu.t1.c[2] == 3); + assert (myu.t1.d[2] == 3); + + #pragma omp target map(myu.t2.a[2:5]) + { + myu.t2.a[2]++; + } + + #pragma omp target map(myu.t2.b[2:5]) + { + myu.t2.b[2]++; + } + + #pragma omp target enter data map(to: myu.t2.c) + + #pragma omp target map(myu.t2.c[2:5]) + { + myu.t2.c[2]++; + } + + #pragma omp target exit data map(release: myu.t2.c) + + #pragma omp target enter data map(to: myu.t2.d) + + #pragma omp target map(myu.t2.d[2:5]) + { + myu.t2.d[2]++; + } + + #pragma omp target exit data map(release: myu.t2.d) + + assert (myu.t2.a[2] == 1); + assert (myu.t2.b[2] == 3); + assert (myu.t2.c[2] == 3); + assert (myu.t2.d[2] == 3); + + #pragma omp target enter data map(to: myu.t3) + + #pragma omp target map(myu.t3->a[2:5]) + { + myu.t3->a[2]++; + } + + #pragma omp target map(myu.t3->b[2:5]) + { + myu.t3->b[2]++; + } + + #pragma omp target enter data map(to: myu.t3->c) + + #pragma omp target map(myu.t3->c[2:5]) + { + myu.t3->c[2]++; + } + + #pragma omp target exit data map(release: myu.t3->c) + + #pragma omp target enter data map(to: myu.t3->d) + + #pragma omp target map(myu.t3->d[2:5]) + { + myu.t3->d[2]++; + } + + #pragma omp target exit data map(release: myu.t3, myu.t3->d) + + assert (myu.t3->a[2] == 1); + assert (myu.t3->b[2] == 3); + assert (myu.t3->c[2] == 3); + assert (myu.t3->d[2] == 3); + + #pragma omp target enter data map(to: myu.t4) + + #pragma omp target map(myu.t4->a[2:5]) + { + myu.t4->a[2]++; + } + + #pragma omp target map(myu.t4->b[2:5]) + { + myu.t4->b[2]++; + } + + #pragma omp target enter data map(to: myu.t4->c) + + #pragma omp target map(myu.t4->c[2:5]) + { + myu.t4->c[2]++; + } + + #pragma omp target exit data map(release: myu.t4->c) + + #pragma omp target enter data map(to: myu.t4->d) + + #pragma omp target map(myu.t4->d[2:5]) + { + myu.t4->d[2]++; + } + + #pragma omp target exit data map(release: myu.t4, myu.t4->d) + + assert (myu.t4->a[2] == 1); + assert (myu.t4->b[2] == 3); + assert (myu.t4->c[2] == 3); + assert (myu.t4->d[2] == 3); + + delete s4; + delete t4; +} +#endif + +#ifdef NONREF_COMPONENT_MEMBER_SLICE_BASEPTR +template +void +nonref_component_member_slice_baseptr (void) +{ + INIT_ST; + U myu(s1, t1, s2, t2, &s3, &t3, s4, t4); + + #pragma omp target map(to: myu.t1.c) map(myu.t1.c[2:5]) + { + myu.t1.c[2]++; + } + + #pragma omp target map(to: myu.t1.d) map(myu.t1.d[2:5]) + { + myu.t1.d[2]++; + } + + assert (myu.t1.c[2] == 2); + assert (myu.t1.d[2] == 2); + + #pragma omp target map(to: myu.t2.c) map(myu.t2.c[2:5]) + { + myu.t2.c[2]++; + } + + #pragma omp target map(to: myu.t2.d) map(myu.t2.d[2:5]) + { + myu.t2.d[2]++; + } + + assert (myu.t2.c[2] == 2); + assert (myu.t2.d[2] == 2); + + #pragma omp target map(to: myu.t3, myu.t3->c) map(myu.t3->c[2:5]) + { + myu.t3->c[2]++; + } + + #pragma omp target map(to: myu.t3, myu.t3->d) map(myu.t3->d[2:5]) + { + myu.t3->d[2]++; + } + + assert (myu.t3->c[2] == 2); + assert (myu.t3->d[2] == 2); + + #pragma omp target map(to: myu.t4, myu.t4->c) map(myu.t4->c[2:5]) + { + myu.t4->c[2]++; + } + + #pragma omp target map(to: myu.t4, myu.t4->d) map(myu.t4->d[2:5]) + { + myu.t4->d[2]++; + } + + assert (myu.t4->c[2] == 2); + assert (myu.t4->d[2] == 2); + + delete s4; + delete t4; +} +#endif + +#ifdef REF_COMPONENT_BASE +template +void +ref_component_base (void) +{ + INIT_ST; + U myu_real(s1, t1, s2, t2, &s3, &t3, s4, t4); + U &myu = myu_real; + + #pragma omp target map(myu.s1.a, myu.s1.b, myu.s1.c, myu.s1.d) + { + myu.s1.a++; + myu.s1.b++; + myu.s1.c++; + myu.s1.d++; + } + + assert (myu.s1.a == 1); + assert (myu.s1.b == 1); + assert (myu.s1.c == &c1 + 1); + assert (myu.s1.d == &d1 + 1); + + #pragma omp target map(myu.s2.a, myu.s2.b, myu.s2.c, myu.s2.d) + { + myu.s2.a++; + myu.s2.b++; + myu.s2.c++; + myu.s2.d++; + } + + assert (myu.s2.a == 1); + assert (myu.s2.b == 1); + assert (myu.s2.c == &c2 + 1); + assert (myu.s2.d == &d2 + 1); + + #pragma omp target map(to:myu.s3) \ + map(myu.s3->a, myu.s3->b, myu.s3->c, myu.s3->d) + { + myu.s3->a++; + myu.s3->b++; + myu.s3->c++; + myu.s3->d++; + } + + assert (myu.s3->a == 1); + assert (myu.s3->b == 1); + assert (myu.s3->c == &c3 + 1); + assert (myu.s3->d == &d3 + 1); + + #pragma omp target map(to:myu.s4) \ + map(myu.s4->a, myu.s4->b, myu.s4->c, myu.s4->d) + { + myu.s4->a++; + myu.s4->b++; + myu.s4->c++; + myu.s4->d++; + } + + assert (myu.s4->a == 1); + assert (myu.s4->b == 1); + assert (myu.s4->c == &c4 + 1); + assert (myu.s4->d == &d4 + 1); + + delete s4; + delete t4; +} +#endif + +#ifdef REF_COMPONENT_MEMBER_SLICE +template +void +ref_component_member_slice (void) +{ + INIT_ST; + U myu_real(s1, t1, s2, t2, &s3, &t3, s4, t4); + U &myu = myu_real; + + #pragma omp target map(myu.t1.a[2:5]) + { + myu.t1.a[2]++; + } + + #pragma omp target map(myu.t1.b[2:5]) + { + myu.t1.b[2]++; + } + + #pragma omp target enter data map(to: myu.t1.c) + + #pragma omp target map(myu.t1.c[2:5]) + { + myu.t1.c[2]++; + } + + #pragma omp target exit data map(release: myu.t1.c) + + #pragma omp target enter data map(to: myu.t1.d) + + #pragma omp target map(myu.t1.d[2:5]) + { + myu.t1.d[2]++; + } + + #pragma omp target exit data map(release: myu.t1.d) + + assert (myu.t1.a[2] == 1); + assert (myu.t1.b[2] == 3); + assert (myu.t1.c[2] == 3); + assert (myu.t1.d[2] == 3); + + #pragma omp target map(myu.t2.a[2:5]) + { + myu.t2.a[2]++; + } + + #pragma omp target map(myu.t2.b[2:5]) + { + myu.t2.b[2]++; + } + + #pragma omp target enter data map(to: myu.t2.c) + + #pragma omp target map(myu.t2.c[2:5]) + { + myu.t2.c[2]++; + } + + #pragma omp target exit data map(release: myu.t2.c) + + #pragma omp target enter data map(to: myu.t2.d) + + #pragma omp target map(myu.t2.d[2:5]) + { + myu.t2.d[2]++; + } + + #pragma omp target exit data map(release: myu.t2.d) + + assert (myu.t2.a[2] == 1); + assert (myu.t2.b[2] == 3); + assert (myu.t2.c[2] == 3); + assert (myu.t2.d[2] == 3); + + #pragma omp target enter data map(to: myu.t3) + + #pragma omp target map(myu.t3->a[2:5]) + { + myu.t3->a[2]++; + } + + #pragma omp target map(myu.t3->b[2:5]) + { + myu.t3->b[2]++; + } + + #pragma omp target enter data map(to: myu.t3->c) + + #pragma omp target map(myu.t3->c[2:5]) + { + myu.t3->c[2]++; + } + + #pragma omp target exit data map(release: myu.t3->c) + + #pragma omp target enter data map(to: myu.t3->d) + + #pragma omp target map(myu.t3->d[2:5]) + { + myu.t3->d[2]++; + } + + #pragma omp target exit data map(release: myu.t3, myu.t3->d) + + assert (myu.t3->a[2] == 1); + assert (myu.t3->b[2] == 3); + assert (myu.t3->c[2] == 3); + assert (myu.t3->d[2] == 3); + + #pragma omp target enter data map(to: myu.t4) + + #pragma omp target map(myu.t4->a[2:5]) + { + myu.t4->a[2]++; + } + + #pragma omp target map(myu.t4->b[2:5]) + { + myu.t4->b[2]++; + } + + #pragma omp target enter data map(to: myu.t4->c) + + #pragma omp target map(myu.t4->c[2:5]) + { + myu.t4->c[2]++; + } + + #pragma omp target exit data map(release: myu.t4->c) + + #pragma omp target enter data map(to: myu.t4->d) + + #pragma omp target map(myu.t4->d[2:5]) + { + myu.t4->d[2]++; + } + + #pragma omp target exit data map(release: myu.t4, myu.t4->d) + + assert (myu.t4->a[2] == 1); + assert (myu.t4->b[2] == 3); + assert (myu.t4->c[2] == 3); + assert (myu.t4->d[2] == 3); + + delete s4; + delete t4; +} +#endif + +#ifdef REF_COMPONENT_MEMBER_SLICE_BASEPTR +template +void +ref_component_member_slice_baseptr (void) +{ + INIT_ST; + U myu_real(s1, t1, s2, t2, &s3, &t3, s4, t4); + U &myu = myu_real; + + #pragma omp target map(to: myu.t1.c) map(myu.t1.c[2:5]) + { + myu.t1.c[2]++; + } + + #pragma omp target map(to: myu.t1.d) map(myu.t1.d[2:5]) + { + myu.t1.d[2]++; + } + + assert (myu.t1.c[2] == 2); + assert (myu.t1.d[2] == 2); + + #pragma omp target map(to: myu.t2.c) map(myu.t2.c[2:5]) + { + myu.t2.c[2]++; + } + + #pragma omp target map(to: myu.t2.d) map(myu.t2.d[2:5]) + { + myu.t2.d[2]++; + } + + assert (myu.t2.c[2] == 2); + assert (myu.t2.d[2] == 2); + + #pragma omp target map(to: myu.t3, myu.t3->c) map(myu.t3->c[2:5]) + { + myu.t3->c[2]++; + } + + #pragma omp target map(to: myu.t3, myu.t3->d) map(myu.t3->d[2:5]) + { + myu.t3->d[2]++; + } + + assert (myu.t3->c[2] == 2); + assert (myu.t3->d[2] == 2); + + #pragma omp target map(to: myu.t4, myu.t4->c) map(myu.t4->c[2:5]) + { + myu.t4->c[2]++; + } + + #pragma omp target map(to: myu.t4, myu.t4->d) map(myu.t4->d[2:5]) + { + myu.t4->d[2]++; + } + + assert (myu.t4->c[2] == 2); + assert (myu.t4->d[2] == 2); + + delete s4; + delete t4; +} +#endif + +#ifdef PTR_COMPONENT_BASE +template +void +ptr_component_base (void) +{ + INIT_ST; + U *myu = new U(s1, t1, s2, t2, &s3, &t3, s4, t4); + + #pragma omp target map(myu->s1.a, myu->s1.b, myu->s1.c, myu->s1.d) + { + myu->s1.a++; + myu->s1.b++; + myu->s1.c++; + myu->s1.d++; + } + + assert (myu->s1.a == 1); + assert (myu->s1.b == 1); + assert (myu->s1.c == &c1 + 1); + assert (myu->s1.d == &d1 + 1); + + #pragma omp target map(myu->s2.a, myu->s2.b, myu->s2.c, myu->s2.d) + { + myu->s2.a++; + myu->s2.b++; + myu->s2.c++; + myu->s2.d++; + } + + assert (myu->s2.a == 1); + assert (myu->s2.b == 1); + assert (myu->s2.c == &c2 + 1); + assert (myu->s2.d == &d2 + 1); + + #pragma omp target map(to:myu->s3) \ + map(myu->s3->a, myu->s3->b, myu->s3->c, myu->s3->d) + { + myu->s3->a++; + myu->s3->b++; + myu->s3->c++; + myu->s3->d++; + } + + assert (myu->s3->a == 1); + assert (myu->s3->b == 1); + assert (myu->s3->c == &c3 + 1); + assert (myu->s3->d == &d3 + 1); + + #pragma omp target map(to:myu->s4) \ + map(myu->s4->a, myu->s4->b, myu->s4->c, myu->s4->d) + { + myu->s4->a++; + myu->s4->b++; + myu->s4->c++; + myu->s4->d++; + } + + assert (myu->s4->a == 1); + assert (myu->s4->b == 1); + assert (myu->s4->c == &c4 + 1); + assert (myu->s4->d == &d4 + 1); + + delete s4; + delete t4; + delete myu; +} +#endif + +#ifdef PTR_COMPONENT_MEMBER_SLICE +template +void +ptr_component_member_slice (void) +{ + INIT_ST; + U *myu = new U(s1, t1, s2, t2, &s3, &t3, s4, t4); + + #pragma omp target map(myu->t1.a[2:5]) + { + myu->t1.a[2]++; + } + + #pragma omp target map(myu->t1.b[2:5]) + { + myu->t1.b[2]++; + } + + #pragma omp target enter data map(to: myu->t1.c) + + #pragma omp target map(myu->t1.c[2:5]) + { + myu->t1.c[2]++; + } + + #pragma omp target exit data map(release: myu->t1.c) + + #pragma omp target enter data map(to: myu->t1.d) + + #pragma omp target map(myu->t1.d[2:5]) + { + myu->t1.d[2]++; + } + + #pragma omp target exit data map(release: myu->t1.d) + + assert (myu->t1.a[2] == 1); + assert (myu->t1.b[2] == 3); + assert (myu->t1.c[2] == 3); + assert (myu->t1.d[2] == 3); + + #pragma omp target map(myu->t2.a[2:5]) + { + myu->t2.a[2]++; + } + + #pragma omp target map(myu->t2.b[2:5]) + { + myu->t2.b[2]++; + } + + #pragma omp target enter data map(to: myu->t2.c) + + #pragma omp target map(myu->t2.c[2:5]) + { + myu->t2.c[2]++; + } + + #pragma omp target exit data map(release: myu->t2.c) + + #pragma omp target enter data map(to: myu->t2.d) + + #pragma omp target map(myu->t2.d[2:5]) + { + myu->t2.d[2]++; + } + + #pragma omp target exit data map(release: myu->t2.d) + + assert (myu->t2.a[2] == 1); + assert (myu->t2.b[2] == 3); + assert (myu->t2.c[2] == 3); + assert (myu->t2.d[2] == 3); + + #pragma omp target enter data map(to: myu->t3) + + #pragma omp target map(myu->t3->a[2:5]) + { + myu->t3->a[2]++; + } + + #pragma omp target map(myu->t3->b[2:5]) + { + myu->t3->b[2]++; + } + + #pragma omp target enter data map(to: myu->t3->c) + + #pragma omp target map(myu->t3->c[2:5]) + { + myu->t3->c[2]++; + } + + #pragma omp target exit data map(release: myu->t3->c) + + #pragma omp target enter data map(to: myu->t3->d) + + #pragma omp target map(myu->t3->d[2:5]) + { + myu->t3->d[2]++; + } + + #pragma omp target exit data map(release: myu->t3, myu->t3->d) + + assert (myu->t3->a[2] == 1); + assert (myu->t3->b[2] == 3); + assert (myu->t3->c[2] == 3); + assert (myu->t3->d[2] == 3); + + #pragma omp target enter data map(to: myu->t4) + + #pragma omp target map(myu->t4->a[2:5]) + { + myu->t4->a[2]++; + } + + #pragma omp target map(myu->t4->b[2:5]) + { + myu->t4->b[2]++; + } + + #pragma omp target enter data map(to: myu->t4->c) + + #pragma omp target map(myu->t4->c[2:5]) + { + myu->t4->c[2]++; + } + + #pragma omp target exit data map(release: myu->t4->c) + + #pragma omp target enter data map(to: myu->t4->d) + + #pragma omp target map(myu->t4->d[2:5]) + { + myu->t4->d[2]++; + } + + #pragma omp target exit data map(release: myu->t4, myu->t4->d) + + assert (myu->t4->a[2] == 1); + assert (myu->t4->b[2] == 3); + assert (myu->t4->c[2] == 3); + assert (myu->t4->d[2] == 3); + + delete s4; + delete t4; + delete myu; +} +#endif + +#ifdef PTR_COMPONENT_MEMBER_SLICE_BASEPTR +template +void +ptr_component_member_slice_baseptr (void) +{ + INIT_ST; + U *myu = new U(s1, t1, s2, t2, &s3, &t3, s4, t4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t1.c) map(myu->t1.c[2:5]) + { + myu->t1.c[2]++; + } + + #pragma omp target map(to: myu->t1.d) map(myu->t1.d[2:5]) + { + myu->t1.d[2]++; + } + + assert (myu->t1.c[2] == 2); + assert (myu->t1.d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t1.c) map(myu->t1.c[2:5]) + { + myu->t1.c[2]++; + } + + #pragma omp target map(to: myu, myu->t1.d) map(myu->t1.d[2:5]) + { + myu->t1.d[2]++; + } + + assert (myu->t1.c[2] == 4); + assert (myu->t1.d[2] == 4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t2.c) map(myu->t2.c[2:5]) + { + myu->t2.c[2]++; + } + + #pragma omp target map(to: myu->t2.d) map(myu->t2.d[2:5]) + { + myu->t2.d[2]++; + } + + assert (myu->t2.c[2] == 2); + assert (myu->t2.d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t2.c) map(myu->t2.c[2:5]) + { + myu->t2.c[2]++; + } + + #pragma omp target map(to: myu, myu->t2.d) map(myu->t2.d[2:5]) + { + myu->t2.d[2]++; + } + + assert (myu->t2.c[2] == 4); + assert (myu->t2.d[2] == 4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t3, myu->t3->c) map(myu->t3->c[2:5]) + { + myu->t3->c[2]++; + } + + #pragma omp target map(to: myu->t3, myu->t3->d) map(myu->t3->d[2:5]) + { + myu->t3->d[2]++; + } + + assert (myu->t3->c[2] == 2); + assert (myu->t3->d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t3, myu->t3->c) map(myu->t3->c[2:5]) + { + myu->t3->c[2]++; + } + + #pragma omp target map(to: myu, myu->t3, myu->t3->d) map(myu->t3->d[2:5]) + { + myu->t3->d[2]++; + } + + assert (myu->t3->c[2] == 4); + assert (myu->t3->d[2] == 4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t4, myu->t4->c) map(myu->t4->c[2:5]) + { + myu->t4->c[2]++; + } + + #pragma omp target map(to: myu->t4, myu->t4->d) map(myu->t4->d[2:5]) + { + myu->t4->d[2]++; + } + + assert (myu->t4->c[2] == 2); + assert (myu->t4->d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t4, myu->t4->c) map(myu->t4->c[2:5]) + { + myu->t4->c[2]++; + } + + #pragma omp target map(to: myu, myu->t4, myu->t4->d) map(myu->t4->d[2:5]) + { + myu->t4->d[2]++; + } + + assert (myu->t4->c[2] == 4); + assert (myu->t4->d[2] == 4); + + delete s4; + delete t4; + delete myu; +} +#endif + +#ifdef REF2PTR_COMPONENT_BASE +template +void +ref2ptr_component_base (void) +{ + INIT_ST; + U *myu_ptr = new U(s1, t1, s2, t2, &s3, &t3, s4, t4); + U *&myu = myu_ptr; + + #pragma omp target map(myu->s1.a, myu->s1.b, myu->s1.c, myu->s1.d) + { + myu->s1.a++; + myu->s1.b++; + myu->s1.c++; + myu->s1.d++; + } + + assert (myu->s1.a == 1); + assert (myu->s1.b == 1); + assert (myu->s1.c == &c1 + 1); + assert (myu->s1.d == &d1 + 1); + + #pragma omp target map(myu->s2.a, myu->s2.b, myu->s2.c, myu->s2.d) + { + myu->s2.a++; + myu->s2.b++; + myu->s2.c++; + myu->s2.d++; + } + + assert (myu->s2.a == 1); + assert (myu->s2.b == 1); + assert (myu->s2.c == &c2 + 1); + assert (myu->s2.d == &d2 + 1); + + #pragma omp target map(to:myu->s3) \ + map(myu->s3->a, myu->s3->b, myu->s3->c, myu->s3->d) + { + myu->s3->a++; + myu->s3->b++; + myu->s3->c++; + myu->s3->d++; + } + + assert (myu->s3->a == 1); + assert (myu->s3->b == 1); + assert (myu->s3->c == &c3 + 1); + assert (myu->s3->d == &d3 + 1); + + #pragma omp target map(to:myu->s4) \ + map(myu->s4->a, myu->s4->b, myu->s4->c, myu->s4->d) + { + myu->s4->a++; + myu->s4->b++; + myu->s4->c++; + myu->s4->d++; + } + + assert (myu->s4->a == 1); + assert (myu->s4->b == 1); + assert (myu->s4->c == &c4 + 1); + assert (myu->s4->d == &d4 + 1); + + delete s4; + delete t4; + delete myu_ptr; +} +#endif + +#ifdef REF2PTR_COMPONENT_MEMBER_SLICE +template +void +ref2ptr_component_member_slice (void) +{ + INIT_ST; + U *myu_ptr = new U(s1, t1, s2, t2, &s3, &t3, s4, t4); + U *&myu = myu_ptr; + + #pragma omp target map(myu->t1.a[2:5]) + { + myu->t1.a[2]++; + } + + #pragma omp target map(myu->t1.b[2:5]) + { + myu->t1.b[2]++; + } + + #pragma omp target enter data map(to: myu->t1.c) + + #pragma omp target map(myu->t1.c[2:5]) + { + myu->t1.c[2]++; + } + + #pragma omp target exit data map(release: myu->t1.c) + + #pragma omp target enter data map(to: myu->t1.d) + + #pragma omp target map(myu->t1.d[2:5]) + { + myu->t1.d[2]++; + } + + #pragma omp target exit data map(release: myu->t1.d) + + assert (myu->t1.a[2] == 1); + assert (myu->t1.b[2] == 3); + assert (myu->t1.c[2] == 3); + assert (myu->t1.d[2] == 3); + + #pragma omp target map(myu->t2.a[2:5]) + { + myu->t2.a[2]++; + } + + #pragma omp target map(myu->t2.b[2:5]) + { + myu->t2.b[2]++; + } + + #pragma omp target enter data map(to: myu->t2.c) + + #pragma omp target map(myu->t2.c[2:5]) + { + myu->t2.c[2]++; + } + + #pragma omp target exit data map(release: myu->t2.c) + + #pragma omp target enter data map(to: myu->t2.d) + + #pragma omp target map(myu->t2.d[2:5]) + { + myu->t2.d[2]++; + } + + #pragma omp target exit data map(release: myu->t2.d) + + assert (myu->t2.a[2] == 1); + assert (myu->t2.b[2] == 3); + assert (myu->t2.c[2] == 3); + assert (myu->t2.d[2] == 3); + + #pragma omp target enter data map(to: myu->t3) + + #pragma omp target map(myu->t3->a[2:5]) + { + myu->t3->a[2]++; + } + + #pragma omp target map(myu->t3->b[2:5]) + { + myu->t3->b[2]++; + } + + #pragma omp target enter data map(to: myu->t3->c) + + #pragma omp target map(myu->t3->c[2:5]) + { + myu->t3->c[2]++; + } + + #pragma omp target exit data map(release: myu->t3->c) + + #pragma omp target enter data map(to: myu->t3->d) + + #pragma omp target map(myu->t3->d[2:5]) + { + myu->t3->d[2]++; + } + + #pragma omp target exit data map(release: myu->t3, myu->t3->d) + + assert (myu->t3->a[2] == 1); + assert (myu->t3->b[2] == 3); + assert (myu->t3->c[2] == 3); + assert (myu->t3->d[2] == 3); + + #pragma omp target enter data map(to: myu->t4) + + #pragma omp target map(myu->t4->a[2:5]) + { + myu->t4->a[2]++; + } + + #pragma omp target map(myu->t4->b[2:5]) + { + myu->t4->b[2]++; + } + + #pragma omp target enter data map(to: myu->t4->c) + + #pragma omp target map(myu->t4->c[2:5]) + { + myu->t4->c[2]++; + } + + #pragma omp target exit data map(release: myu->t4->c) + + #pragma omp target enter data map(to: myu->t4->d) + + #pragma omp target map(myu->t4->d[2:5]) + { + myu->t4->d[2]++; + } + + #pragma omp target exit data map(release: myu->t4, myu->t4->d) + + assert (myu->t4->a[2] == 1); + assert (myu->t4->b[2] == 3); + assert (myu->t4->c[2] == 3); + assert (myu->t4->d[2] == 3); + + delete s4; + delete t4; + delete myu_ptr; +} +#endif + +#ifdef REF2PTR_COMPONENT_MEMBER_SLICE_BASEPTR +template +void +ref2ptr_component_member_slice_baseptr (void) +{ + INIT_ST; + U *myu_ptr = new U(s1, t1, s2, t2, &s3, &t3, s4, t4); + U *&myu = myu_ptr; + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t1.c) map(myu->t1.c[2:5]) + { + myu->t1.c[2]++; + } + + #pragma omp target map(to: myu->t1.d) map(myu->t1.d[2:5]) + { + myu->t1.d[2]++; + } + + assert (myu->t1.c[2] == 2); + assert (myu->t1.d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t1.c) map(myu->t1.c[2:5]) + { + myu->t1.c[2]++; + } + + #pragma omp target map(to: myu, myu->t1.d) map(myu->t1.d[2:5]) + { + myu->t1.d[2]++; + } + + assert (myu->t1.c[2] == 4); + assert (myu->t1.d[2] == 4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t2.c) map(myu->t2.c[2:5]) + { + myu->t2.c[2]++; + } + + #pragma omp target map(to: myu->t2.d) map(myu->t2.d[2:5]) + { + myu->t2.d[2]++; + } + + assert (myu->t2.c[2] == 2); + assert (myu->t2.d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t2.c) map(myu->t2.c[2:5]) + { + myu->t2.c[2]++; + } + + #pragma omp target map(to: myu, myu->t2.d) map(myu->t2.d[2:5]) + { + myu->t2.d[2]++; + } + + assert (myu->t2.c[2] == 4); + assert (myu->t2.d[2] == 4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t3, myu->t3->c) map(myu->t3->c[2:5]) + { + myu->t3->c[2]++; + } + + #pragma omp target map(to: myu->t3, myu->t3->d) map(myu->t3->d[2:5]) + { + myu->t3->d[2]++; + } + + assert (myu->t3->c[2] == 2); + assert (myu->t3->d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t3, myu->t3->c) map(myu->t3->c[2:5]) + { + myu->t3->c[2]++; + } + + #pragma omp target map(to: myu, myu->t3, myu->t3->d) map(myu->t3->d[2:5]) + { + myu->t3->d[2]++; + } + + assert (myu->t3->c[2] == 4); + assert (myu->t3->d[2] == 4); + + /* Implicit firstprivate 'myu'. */ + #pragma omp target map(to: myu->t4, myu->t4->c) map(myu->t4->c[2:5]) + { + myu->t4->c[2]++; + } + + #pragma omp target map(to: myu->t4, myu->t4->d) map(myu->t4->d[2:5]) + { + myu->t4->d[2]++; + } + + assert (myu->t4->c[2] == 2); + assert (myu->t4->d[2] == 2); + + /* Explicitly-mapped 'myu'. */ + #pragma omp target map(to: myu, myu->t4, myu->t4->c) map(myu->t4->c[2:5]) + { + myu->t4->c[2]++; + } + + #pragma omp target map(to: myu, myu->t4, myu->t4->d) map(myu->t4->d[2:5]) + { + myu->t4->d[2]++; + } + + assert (myu->t4->c[2] == 4); + assert (myu->t4->d[2] == 4); + + delete s4; + delete t4; + delete myu_ptr; +} +#endif + +int main (int argc, char *argv[]) +{ +#ifdef MAP_DECLS + map_decls<4> (); +#endif + +#ifdef NONREF_DECL_BASE + nonref_decl_base (); +#endif +#ifdef REF_DECL_BASE + ref_decl_base (); +#endif +#ifdef PTR_DECL_BASE + ptr_decl_base (); +#endif +#ifdef REF2PTR_DECL_BASE + ref2ptr_decl_base (); +#endif + +#ifdef ARRAY_DECL_BASE + array_decl_base (); +#endif +#ifdef REF2ARRAY_DECL_BASE + ref2array_decl_base (); +#endif +#ifdef PTR_OFFSET_DECL_BASE + ptr_offset_decl_base (); +#endif +#ifdef REF2PTR_OFFSET_DECL_BASE + ref2ptr_offset_decl_base (); +#endif + +#ifdef MAP_SECTIONS + map_sections (); +#endif + +#ifdef NONREF_DECL_MEMBER_SLICE + nonref_decl_member_slice (); +#endif +#ifdef NONREF_DECL_MEMBER_SLICE_BASEPTR + nonref_decl_member_slice_baseptr (); +#endif +#ifdef REF_DECL_MEMBER_SLICE + ref_decl_member_slice (); +#endif +#ifdef REF_DECL_MEMBER_SLICE_BASEPTR + ref_decl_member_slice_baseptr (); +#endif +#ifdef PTR_DECL_MEMBER_SLICE + ptr_decl_member_slice (); +#endif +#ifdef PTR_DECL_MEMBER_SLICE_BASEPTR + ptr_decl_member_slice_baseptr (); +#endif +#ifdef REF2PTR_DECL_MEMBER_SLICE + ref2ptr_decl_member_slice (); +#endif +#ifdef REF2PTR_DECL_MEMBER_SLICE_BASEPTR + ref2ptr_decl_member_slice_baseptr (); +#endif + +#ifdef ARRAY_DECL_MEMBER_SLICE + array_decl_member_slice (); +#endif +#ifdef ARRAY_DECL_MEMBER_SLICE_BASEPTR + array_decl_member_slice_baseptr (); +#endif +#ifdef REF2ARRAY_DECL_MEMBER_SLICE + ref2array_decl_member_slice (); +#endif +#ifdef REF2ARRAY_DECL_MEMBER_SLICE_BASEPTR + ref2array_decl_member_slice_baseptr (); +#endif +#ifdef PTR_OFFSET_DECL_MEMBER_SLICE + ptr_offset_decl_member_slice (); +#endif +#ifdef PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR + ptr_offset_decl_member_slice_baseptr (); +#endif +#ifdef REF2PTR_OFFSET_DECL_MEMBER_SLICE + ref2ptr_offset_decl_member_slice (); +#endif +#ifdef REF2PTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR + ref2ptr_offset_decl_member_slice_baseptr (); +#endif + +#ifdef PTRARRAY_DECL_MEMBER_SLICE + ptrarray_decl_member_slice (); +#endif +#ifdef PTRARRAY_DECL_MEMBER_SLICE_BASEPTR + ptrarray_decl_member_slice_baseptr (); +#endif +#ifdef REF2PTRARRAY_DECL_MEMBER_SLICE + ref2ptrarray_decl_member_slice (); +#endif +#ifdef REF2PTRARRAY_DECL_MEMBER_SLICE_BASEPTR + ref2ptrarray_decl_member_slice_baseptr (); +#endif +#ifdef PTRPTR_OFFSET_DECL_MEMBER_SLICE + ptrptr_offset_decl_member_slice (); +#endif +#ifdef PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR + ptrptr_offset_decl_member_slice_baseptr (); +#endif +#ifdef REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE + ref2ptrptr_offset_decl_member_slice (); +#endif +#ifdef REF2PTRPTR_OFFSET_DECL_MEMBER_SLICE_BASEPTR + ref2ptrptr_offset_decl_member_slice_baseptr (); +#endif + +#ifdef NONREF_COMPONENT_BASE + nonref_component_base (); +#endif +#ifdef NONREF_COMPONENT_MEMBER_SLICE + nonref_component_member_slice (); +#endif +#ifdef NONREF_COMPONENT_MEMBER_SLICE_BASEPTR + nonref_component_member_slice_baseptr (); +#endif + +#ifdef REF_COMPONENT_BASE + ref_component_base (); +#endif +#ifdef REF_COMPONENT_MEMBER_SLICE + ref_component_member_slice (); +#endif +#ifdef REF_COMPONENT_MEMBER_SLICE_BASEPTR + ref_component_member_slice_baseptr (); +#endif + +#ifdef PTR_COMPONENT_BASE + ptr_component_base (); +#endif +#ifdef PTR_COMPONENT_MEMBER_SLICE + ptr_component_member_slice (); +#endif +#ifdef PTR_COMPONENT_MEMBER_SLICE_BASEPTR + ptr_component_member_slice_baseptr (); +#endif + +#ifdef REF2PTR_COMPONENT_BASE + ref2ptr_component_base (); +#endif +#ifdef REF2PTR_COMPONENT_MEMBER_SLICE + ref2ptr_component_member_slice (); +#endif +#ifdef REF2PTR_COMPONENT_MEMBER_SLICE_BASEPTR + ref2ptr_component_member_slice_baseptr (); +#endif + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/ind-base-1.C b/libgomp/testsuite/libgomp.c++/ind-base-1.C new file mode 100644 index 000000000000..4566854e60ae --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/ind-base-1.C @@ -0,0 +1,162 @@ +// { dg-do run } +// { dg-options "-fopenmp" } + +#include + +struct S +{ + int x[10]; +}; + +struct T +{ + struct S *s; +}; + +struct U +{ + struct T *t; +}; + +void +foo_siblist (void) +{ + U *u = new U; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + u->t->s->x[i] = 0; +#pragma omp target map(u->t, *(u->t), u->t->s, *u->t->s) + for (int i = 0; i < 10; i++) + u->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert (u->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +void +foo (void) +{ + U *u = new U; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + u->t->s->x[i] = 0; +#pragma omp target map(*u, u->t, *(u->t), u->t->s, *u->t->s) + for (int i = 0; i < 10; i++) + u->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert (u->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +void +foo_tofrom (void) +{ + U *u = new U; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + u->t->s->x[i] = 0; +#pragma omp target map(u, *u, u->t, *(u->t), u->t->s, *u->t->s) + for (int i = 0; i < 10; i++) + u->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert (u->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +void +bar (void) +{ + U *u = new U; + U **up = &u; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = 0; +#pragma omp target map(*up, (*up)->t, *(*up)->t, (*up)->t->s, *(*up)->t->s) + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((*up)->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +void +bar_pp (void) +{ + U *u = new U; + U **up = &u; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = 0; +#pragma omp target map(*up, **up, (*up)->t, *(*up)->t, (*up)->t->s, *(*up)->t->s) + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((*up)->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +void +bar_tofrom (void) +{ + U *u = new U; + U **up = &u; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = 0; +#pragma omp target map(*up, up, (*up)->t, *(*up)->t, (*up)->t->s, *(*up)->t->s) + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((*up)->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +void +bar_tofrom_pp (void) +{ + U *u = new U; + U **up = &u; + u->t = new T; + u->t->s = new S; + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = 0; +#pragma omp target map(**up, *up, up, (*up)->t, *(*up)->t, (*up)->t->s, \ + *(*up)->t->s) + for (int i = 0; i < 10; i++) + (*up)->t->s->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((*up)->t->s->x[i] == i * 3); + delete u->t->s; + delete u->t; + delete u; +} + +int main (int argc, char *argv[]) +{ + foo_siblist (); + foo (); + foo_tofrom (); + bar (); + bar_pp (); + bar_tofrom (); + bar_tofrom_pp (); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/ind-base-2.C b/libgomp/testsuite/libgomp.c++/ind-base-2.C new file mode 100644 index 000000000000..4c05c2ef8f61 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/ind-base-2.C @@ -0,0 +1,93 @@ +// { dg-do run } +// { dg-options "-fopenmp" } + +#include + +struct S +{ + int x[10]; +}; + +struct T +{ + struct S ***s; +}; + +struct U +{ + struct T **t; +}; + +void +foo (void) +{ + U *u = new U; + T *real_t = new T; + S *real_s = new S; + T **t_pp = &real_t; + S **s_pp = &real_s; + S ***s_ppp = &s_pp; + u->t = t_pp; + (*u->t)->s = s_ppp; + for (int i = 0; i < 10; i++) + (**((*u->t)->s))->x[i] = 0; +#pragma omp target map(u->t, *u->t, (*u->t)->s, *(*u->t)->s, **(*u->t)->s, \ + (**(*u->t)->s)->x[0:10]) + for (int i = 0; i < 10; i++) + (**((*u->t)->s))->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((**((*u->t)->s))->x[i] == i * 3); + delete real_s; + delete real_t; + delete u; +} + +template +struct St +{ + X x[10]; +}; + +template +struct Tt +{ + X ***s; +}; + +template +struct Ut +{ + X **t; +}; + +template +void +tfoo (void) +{ + Ut > > *u = new Ut > >; + Tt > *real_t = new Tt >; + St *real_s = new St; + Tt > **t_pp = &real_t; + St **s_pp = &real_s; + St ***s_ppp = &s_pp; + u->t = t_pp; + (*u->t)->s = s_ppp; + for (int i = 0; i < 10; i++) + (**((*u->t)->s))->x[i] = 0; +#pragma omp target map(u->t, *u->t, (*u->t)->s, *(*u->t)->s, **(*u->t)->s, \ + (**(*u->t)->s)->x[0:10]) + for (int i = 0; i < 10; i++) + (**((*u->t)->s))->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((**((*u->t)->s))->x[i] == i * 3); + delete real_s; + delete real_t; + delete u; +} + +int main (int argc, char *argv[]) +{ + foo (); + tfoo (); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/lvalue-tofrom-1.C b/libgomp/testsuite/libgomp.c++/lvalue-tofrom-1.C new file mode 100644 index 000000000000..643cfdb6e28b --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/lvalue-tofrom-1.C @@ -0,0 +1,75 @@ +#include +#include + +static int lo() +{ + return 30; +} + +static int len() +{ + return 10; +} + +template +void foo () +{ + T arr[100]; + T *ptr; + + memset (arr, '\0', sizeof arr); + +#pragma omp target enter data map(to: arr[0:100]) + + for (int i = 0; i < 100; i++) + arr[i] = i; + + ptr = &arr[10]; + +#pragma omp target update to(*ptr) + + for (int i = lo (); i < lo () + len (); i++) + arr[i] = i * 2; + +#pragma omp target update to(arr[lo():len()]) + +#pragma omp target exit data map(from: arr[0:100]) + + assert (arr[10] == 10); + for (int i = lo (); i < lo () + len (); i++) + assert (arr[i] == i * 2); +} + +int +main () +{ + char arr[100]; + char *ptr; + + memset (arr, '\0', sizeof arr); + +#pragma omp target enter data map(to: arr[0:100]) + + for (int i = 0; i < 100; i++) + arr[i] = i; + + ptr = &arr[10]; + +#pragma omp target update to(*ptr) + + for (int i = lo (); i < lo () + len (); i++) + arr[i] = i * 2; + +#pragma omp target update to(arr[lo():len()]) + +#pragma omp target exit data map(from: arr[0:100]) + + assert (arr[10] == 10); + for (int i = lo (); i < lo () + len (); i++) + assert (arr[i] == i * 2); + + foo (); + + return 0; +} + diff --git a/libgomp/testsuite/libgomp.c++/lvalue-tofrom-2.C b/libgomp/testsuite/libgomp.c++/lvalue-tofrom-2.C new file mode 100644 index 000000000000..adc493b1315c --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/lvalue-tofrom-2.C @@ -0,0 +1,71 @@ +#include +#include +#include + +template +struct t_array_wrapper { + T *data; + unsigned int length; +}; + +template +void foo() +{ + struct t_array_wrapper aw; + + aw.data = new T[100]; + aw.length = 100; + +#pragma omp target enter data map(to: aw.data, aw.length) \ + map(alloc: aw.data[0:aw.length]) + +#pragma omp target + for (int i = 0; i < aw.length; i++) + aw.data[i] = i; + +#pragma omp target update from(aw.data[:aw.length]) + +#pragma omp target exit data map(delete: aw.data, aw.length, \ + aw.data[0:aw.length]) + + for (int i = 0; i < aw.length; i++) + assert (aw.data[i] == i); + + delete[] aw.data; +} + +struct array_wrapper { + int *data; + unsigned int length; +}; + +int +main () +{ + struct array_wrapper aw; + + aw.data = new int[100]; + aw.length = 100; + +#pragma omp target enter data map(to: aw.data, aw.length) \ + map(alloc: aw.data[0:aw.length]) + +#pragma omp target + for (int i = 0; i < aw.length; i++) + aw.data[i] = i; + +#pragma omp target update from(aw.data[:aw.length]) + +#pragma omp target exit data map(delete: aw.data, aw.length, \ + aw.data[0:aw.length]) + + for (int i = 0; i < aw.length; i++) + assert (aw.data[i] == i); + + delete[] aw.data; + + foo (); + + return 0; +} + diff --git a/libgomp/testsuite/libgomp.c++/map-comma-1.C b/libgomp/testsuite/libgomp.c++/map-comma-1.C new file mode 100644 index 000000000000..ee03c5ac1aa3 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/map-comma-1.C @@ -0,0 +1,15 @@ +/* { dg-do run } */ + +#include + +int main (int argc, char *argv[]) +{ + int a = 5, b = 7; +#pragma omp target map((a, b)) + { + a++; + b++; + } + assert (a == 5 && b == 8); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/map-rvalue-ref-1.C b/libgomp/testsuite/libgomp.c++/map-rvalue-ref-1.C new file mode 100644 index 000000000000..93811da40007 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/map-rvalue-ref-1.C @@ -0,0 +1,22 @@ +/* { dg-do run } */ + +#include + +int foo (int &&x) +{ + int y; +#pragma omp target map(x, y) + { + x++; + y = x; + } + return y; +} + +int main (int argc, char *argv[]) +{ + int y = 5; + y = foo (y + 3); + assert (y == 9); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/struct-ref-1.C b/libgomp/testsuite/libgomp.c++/struct-ref-1.C new file mode 100644 index 000000000000..d38746500178 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/struct-ref-1.C @@ -0,0 +1,97 @@ +// { dg-do run } +// { dg-options "-fopenmp" } + +#include + +struct S +{ + int x[10]; +}; + +void +foo (S *s, int x) +{ + S *&r = s; + for (int i = 0; i < x; i++) + s[0].x[i] = s[1].x[i] = 0; + #pragma omp target map (s, x) + ; + #pragma omp target map (s[0], x) + for (int i = 0; i < x; i++) + s[0].x[i] = i; + #pragma omp target map (s[1], x) + for (int i = 0; i < x; i++) + s[1].x[i] = i * 2; + for (int i = 0; i < x; i++) + { + assert (s[0].x[i] == i); + assert (s[1].x[i] == i * 2); + s[0].x[i] = 0; + s[1].x[i] = 0; + } + #pragma omp target map (r, x) + ; + #pragma omp target map (r[0], x) + for (int i = 0; i < x; i++) + r[0].x[i] = i; + #pragma omp target map (r[1], x) + for (int i = 0; i < x; i++) + r[1].x[i] = i * 2; + for (int i = 0; i < x; i++) + { + assert (r[0].x[i] == i); + assert (r[1].x[i] == i * 2); + } +} + +template +struct T +{ + int x[N]; +}; + +template +void +bar (T *t, int x) +{ + T *&r = t; + for (int i = 0; i < x; i++) + t[0].x[i] = t[1].x[i] = 0; + #pragma omp target map (t, x) + ; + #pragma omp target map (t[0], x) + for (int i = 0; i < x; i++) + t[0].x[i] = i; + #pragma omp target map (t[1], x) + for (int i = 0; i < x; i++) + t[1].x[i] = i * 2; + for (int i = 0; i < x; i++) + { + assert (t[0].x[i] == i); + assert (t[1].x[i] == i * 2); + t[0].x[i] = 0; + t[1].x[i] = 0; + } + #pragma omp target map (r, x) + ; + #pragma omp target map (r[0], x) + for (int i = 0; i < x; i++) + r[0].x[i] = i; + #pragma omp target map (r[1], x) + for (int i = 0; i < x; i++) + r[1].x[i] = i * 2; + for (int i = 0; i < x; i++) + { + assert (r[0].x[i] == i); + assert (r[1].x[i] == i * 2); + } +} + +int main (int argc, char *argv[]) +{ + S s[2]; + foo (s, 10); + T<10> t[2]; + bar (t, 10); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/array-field-1.c b/libgomp/testsuite/libgomp.c-c++-common/array-field-1.c new file mode 100644 index 000000000000..6dd8b5c48e1e --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/array-field-1.c @@ -0,0 +1,35 @@ +/* { dg-do run } */ + +#include +#include +#include + +#define N 16 + +struct Z { + int *ptr; + int arr[N]; + int c; +}; + +int main (int argc, char *argv[]) +{ + struct Z *myz; + myz = (struct Z *) calloc (1, sizeof *myz); + +#pragma omp target map(tofrom:myz->arr[0:N], myz->c) + { + for (int i = 0; i < N; i++) + myz->arr[i]++; + myz->c++; + } + + for (int i = 0; i < N; i++) + assert (myz->arr[i] == 1); + assert (myz->c == 1); + + free (myz); + + return 0; +} + diff --git a/libgomp/testsuite/libgomp.c-c++-common/array-of-struct-1.c b/libgomp/testsuite/libgomp.c-c++-common/array-of-struct-1.c new file mode 100644 index 000000000000..11215b1df7a3 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/array-of-struct-1.c @@ -0,0 +1,65 @@ +/* { dg-do run } */ + +#include +#include +#include + +#define N 16 + +/* NOTE: This test is the same as array-of-struct-2.c, except the fields of + this struct are in a different order. */ + +struct Z { + int arr[N]; + int *ptr; + int c; +}; + +void +foo (struct Z *zarr, int len) +{ +#pragma omp target map(to:zarr, zarr[5].ptr) map(tofrom:zarr[5].ptr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[5].ptr[i]++; + } + +#pragma omp target map(to:zarr) map(tofrom:zarr[4].arr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[4].arr[i]++; + } + +#pragma omp target map (to:zarr[3].ptr) map(tofrom:zarr[3].ptr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[3].ptr[i]++; + } + +#pragma omp target map(tofrom:zarr[2].arr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[2].arr[i]++; + } +} + +int main (int argc, char *argv[]) +{ + struct Z zs[10]; + memset (zs, 0, sizeof zs); + + for (int i = 0; i < 10; i++) + zs[i].ptr = (int *) calloc (N, sizeof (int)); + + foo (zs, N); + + for (int i = 0; i < N; i++) + { + assert (zs[2].arr[i] == 1); + assert (zs[4].arr[i] == 1); + assert (zs[3].ptr[i] == 1); + assert (zs[5].ptr[i] == 1); + } + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/array-of-struct-2.c b/libgomp/testsuite/libgomp.c-c++-common/array-of-struct-2.c new file mode 100644 index 000000000000..d5d74b8c07d6 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/array-of-struct-2.c @@ -0,0 +1,65 @@ +/* { dg-do run } */ + +#include +#include +#include + +#define N 16 + +/* NOTE: This test is the same as array-of-struct-1.c, except the fields of + this struct are in a different order. */ + +struct Z { + int *ptr; + int arr[N]; + int c; +}; + +void +foo (struct Z *zarr, int len) +{ +#pragma omp target map(to:zarr, zarr[5].ptr) map(tofrom:zarr[5].ptr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[5].ptr[i]++; + } + +#pragma omp target map(to:zarr) map(tofrom:zarr[4].arr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[4].arr[i]++; + } + +#pragma omp target map (to:zarr[3].ptr) map(tofrom:zarr[3].ptr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[3].ptr[i]++; + } + +#pragma omp target map(tofrom:zarr[2].arr[0:len]) + { + for (int i = 0; i < len; i++) + zarr[2].arr[i]++; + } +} + +int main (int argc, char *argv[]) +{ + struct Z zs[10]; + memset (zs, 0, sizeof zs); + + for (int i = 0; i < 10; i++) + zs[i].ptr = (int *) calloc (N, sizeof (int)); + + foo (zs, N); + + for (int i = 0; i < N; i++) + { + assert (zs[2].arr[i] == 1); + assert (zs[4].arr[i] == 1); + assert (zs[3].ptr[i] == 1); + assert (zs[5].ptr[i] == 1); + } + + return 0; +} From patchwork Tue Sep 5 19:28:22 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830095 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=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 (ip-8-43-85-97.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 4RgFtr11Blz1yg7 for ; Wed, 6 Sep 2023 05:29:24 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6CDB1385E002 for ; Tue, 5 Sep 2023 19:29:21 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 4BDCF385842C; Tue, 5 Sep 2023 19:29:04 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4BDCF385842C 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="6.02,229,1688457600"; d="scan'208";a="16179080" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:28:58 -0800 IronPort-SDR: OP+9LNLGh5d7oJS0Uvx5VT1RbHIe2iBfoRSdSDYi1dTWbFKeBRjRNa9r3g5Ek9FXnwGoaaWoKk uuqkwlvIl6tl4poTzPA+a/o5LfyiBWNdK5pjPLA1O1JSCoQ7yfBpzV0XK06SYBqP82KFQv0vpX DCKjdB13JptxyKbzmCimniqz+TE9zTAZIiIidbKdSkuTGnBOmX7QH2GMKhtNVNS+FlRFe4s2Mm Iok40y8WlXn+zfJqeR00BI35pRodDuL2skEXJIv3v3RJs/5oiMeyI58WobwpBv0nJFeB0qEBHB DEA= From: Julian Brown To: CC: , , Subject: [PATCH 2/8] OpenMP: lvalue parsing for map/to/from clauses (C) Date: Tue, 5 Sep 2023 12:28:22 -0700 Message-ID: <78fa6c4dae60578a8feffe204bfe24d85d19520c.1693941293.git.julian@codesourcery.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: 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.8 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, 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 Sender: "Gcc-patches" This patch adds support for parsing general lvalues ("locator list item types") for OpenMP "map", "to" and "from" clauses to the C front-end, similar to the previously-posted patch for C++. Such syntax is permitted for OpenMP 5.0 and above. It was previously posted for mainline here: https://gcc.gnu.org/pipermail/gcc-patches/2022-December/609038.html and for the og13 branch here: https://gcc.gnu.org/pipermail/gcc-patches/2023-June/623355.html 2023-09-05 Julian Brown gcc/c/ * c-pretty-print.cc (c_pretty_printer::postfix_expression, c_pretty_printer::expression): Add OMP_ARRAY_SECTION support. * c-parser.cc (c_parser_braced_init, c_parser_conditional_expression): Don't allow OpenMP array section. (c_parser_postfix_expression): Don't allow array section in statement expression. (c_parser_postfix_expression_after_primary): Add support for OpenMP array section parsing. (c_parser_expr_list): Don't allow OpenMP array section here. (c_parser_omp_variable_list): Change ALLOW_DEREF parameter to MAP_LVALUE. Support parsing of general lvalues in "map", "to" and "from" clauses. (c_parser_omp_var_list_parens): Change ALLOW_DEREF parameter to MAP_LVALUE. Update call to c_parser_omp_variable_list. (c_parser_oacc_data_clause): Update calls to c_parser_omp_var_list_parens. (c_parser_omp_clause_reduction): Use OMP_ARRAY_SECTION tree node instead of TREE_LIST for array sections. (c_parser_omp_target): Allow GOMP_MAP_ATTACH. * c-tree.h (c_omp_array_section_p): Add extern declaration. (build_omp_array_section): Add prototype. * c-typeck.c (c_omp_array_section_p): Add flag. (mark_exp_read): Support OMP_ARRAY_SECTION. (build_omp_array_section): Add function. (build_external_ref): Tweak error path for OpenMP array sections. (handle_omp_array_sections_1): Use OMP_ARRAY_SECTION tree code instead of TREE_LIST. Handle more kinds of expressions. (c_oacc_check_attachments): Use OMP_ARRAY_SECTION instead of TREE_LIST for array sections. (c_finish_omp_clauses): Use OMP_ARRAY_SECTION instead of TREE_LIST. Check for supported expression types. gcc/testsuite/ * gcc.dg/gomp/bad-array-section-c-1.c: New test. * gcc.dg/gomp/bad-array-section-c-2.c: New test. * gcc.dg/gomp/bad-array-section-c-3.c: New test. * gcc.dg/gomp/bad-array-section-c-4.c: New test. * gcc.dg/gomp/bad-array-section-c-5.c: New test. * gcc.dg/gomp/bad-array-section-c-6.c: New test. * gcc.dg/gomp/bad-array-section-c-7.c: New test. * gcc.dg/gomp/bad-array-section-c-8.c: New test. libgomp/ * testsuite/libgomp.c-c++-common/ind-base-4.c: New test. * testsuite/libgomp.c-c++-common/unary-ptr-1.c: New test. --- gcc/c-family/c-pretty-print.cc | 12 ++ gcc/c/c-parser.cc | 181 +++++++++++++++--- gcc/c/c-tree.h | 2 + gcc/c/c-typeck.cc | 109 +++++++++-- .../gcc.dg/gomp/bad-array-section-c-1.c | 16 ++ .../gcc.dg/gomp/bad-array-section-c-2.c | 13 ++ .../gcc.dg/gomp/bad-array-section-c-3.c | 24 +++ .../gcc.dg/gomp/bad-array-section-c-4.c | 26 +++ .../gcc.dg/gomp/bad-array-section-c-5.c | 15 ++ .../gcc.dg/gomp/bad-array-section-c-6.c | 16 ++ .../gcc.dg/gomp/bad-array-section-c-7.c | 26 +++ .../gcc.dg/gomp/bad-array-section-c-8.c | 21 ++ .../libgomp.c-c++-common/ind-base-4.c | 50 +++++ .../libgomp.c-c++-common/unary-ptr-1.c | 16 ++ 14 files changed, 482 insertions(+), 45 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-1.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-2.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-3.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-4.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-5.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-6.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-7.c create mode 100644 gcc/testsuite/gcc.dg/gomp/bad-array-section-c-8.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/ind-base-4.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/unary-ptr-1.c diff --git a/gcc/c-family/c-pretty-print.cc b/gcc/c-family/c-pretty-print.cc index 7536a7c471ff..225ac7ef2851 100644 --- a/gcc/c-family/c-pretty-print.cc +++ b/gcc/c-family/c-pretty-print.cc @@ -1615,6 +1615,17 @@ c_pretty_printer::postfix_expression (tree e) pp_c_right_bracket (this); break; + case OMP_ARRAY_SECTION: + postfix_expression (TREE_OPERAND (e, 0)); + pp_c_left_bracket (this); + if (TREE_OPERAND (e, 1)) + expression (TREE_OPERAND (e, 1)); + pp_colon (this); + if (TREE_OPERAND (e, 2)) + expression (TREE_OPERAND (e, 2)); + pp_c_right_bracket (this); + break; + case CALL_EXPR: { call_expr_arg_iterator iter; @@ -2664,6 +2675,7 @@ c_pretty_printer::expression (tree e) case POSTINCREMENT_EXPR: case POSTDECREMENT_EXPR: case ARRAY_REF: + case OMP_ARRAY_SECTION: case CALL_EXPR: case COMPONENT_REF: case BIT_FIELD_REF: diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index ae3a25737151..36215096af4c 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -5767,6 +5767,8 @@ c_parser_braced_init (c_parser *parser, tree type, bool nested_p, location_t brace_loc = c_parser_peek_token (parser)->location; gcc_obstack_init (&braced_init_obstack); gcc_assert (c_parser_next_token_is (parser, CPP_OPEN_BRACE)); + bool save_c_omp_array_section_p = c_omp_array_section_p; + c_omp_array_section_p = false; matching_braces braces; braces.consume_open (parser); if (nested_p) @@ -5805,6 +5807,7 @@ c_parser_braced_init (c_parser *parser, tree type, bool nested_p, break; } } + c_omp_array_section_p = save_c_omp_array_section_p; c_token *next_tok = c_parser_peek_token (parser); if (next_tok->type != CPP_CLOSE_BRACE) { @@ -8194,6 +8197,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, { struct c_expr cond, exp1, exp2, ret; location_t start, cond_loc, colon_loc; + bool save_c_omp_array_section_p = c_omp_array_section_p; gcc_assert (!after || c_dialect_objc ()); @@ -8201,6 +8205,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, if (c_parser_next_token_is_not (parser, CPP_QUERY)) return cond; + c_omp_array_section_p = false; if (cond.value != error_mark_node) start = cond.get_start (); else @@ -8253,6 +8258,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, ret.set_error (); ret.original_code = ERROR_MARK; ret.original_type = NULL; + c_omp_array_section_p = save_c_omp_array_section_p; return ret; } { @@ -8299,6 +8305,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, } set_c_expr_source_range (&ret, start, exp2.get_finish ()); ret.m_decimal = 0; + c_omp_array_section_p = save_c_omp_array_section_p; return ret; } @@ -9750,6 +9757,7 @@ c_parser_postfix_expression (c_parser *parser) /* A statement expression. */ tree stmt; location_t brace_loc; + bool save_c_omp_array_section_p = c_omp_array_section_p; c_parser_consume_token (parser); brace_loc = c_parser_peek_token (parser)->location; c_parser_consume_token (parser); @@ -9766,6 +9774,7 @@ c_parser_postfix_expression (c_parser *parser) expr.set_error (); break; } + c_omp_array_section_p = false; stmt = c_begin_stmt_expr (); c_parser_compound_statement_nostart (parser); location_t close_loc = c_parser_peek_token (parser)->location; @@ -9776,6 +9785,7 @@ c_parser_postfix_expression (c_parser *parser) expr.value = c_finish_stmt_expr (brace_loc, stmt); set_c_expr_source_range (&expr, loc, close_loc); mark_exp_read (expr.value); + c_omp_array_section_p = save_c_omp_array_section_p; } else { @@ -11234,7 +11244,7 @@ c_parser_postfix_expression_after_primary (c_parser *parser, struct c_expr expr) { struct c_expr orig_expr; - tree ident, idx; + tree ident, idx, len; location_t sizeof_arg_loc[3], comp_loc; tree sizeof_arg[3]; unsigned int literal_zero_mask; @@ -11253,16 +11263,41 @@ c_parser_postfix_expression_after_primary (c_parser *parser, case CPP_OPEN_SQUARE: /* Array reference. */ c_parser_consume_token (parser); - idx = c_parser_expression (parser).value; - c_parser_skip_until_found (parser, CPP_CLOSE_SQUARE, - "expected %<]%>"); - start = expr.get_start (); - finish = parser->tokens_buf[0].location; - expr.value = build_array_ref (op_loc, expr.value, idx); - set_c_expr_source_range (&expr, start, finish); - expr.original_code = ERROR_MARK; - expr.original_type = NULL; - expr.m_decimal = 0; + idx = len = NULL_TREE; + if (!c_omp_array_section_p + || c_parser_next_token_is_not (parser, CPP_COLON)) + idx = c_parser_expression (parser).value; + + if (c_omp_array_section_p + && c_parser_next_token_is (parser, CPP_COLON)) + { + c_parser_consume_token (parser); + if (c_parser_next_token_is_not (parser, CPP_CLOSE_SQUARE)) + len = c_parser_expression (parser).value; + + c_parser_skip_until_found (parser, CPP_CLOSE_SQUARE, + "expected %<]%>"); + + start = expr.get_start (); + finish = parser->tokens_buf[0].location; + expr.value = build_omp_array_section (op_loc, expr.value, idx, + len); + set_c_expr_source_range (&expr, start, finish); + expr.original_code = ERROR_MARK; + expr.original_type = NULL; + } + else + { + c_parser_skip_until_found (parser, CPP_CLOSE_SQUARE, + "expected %<]%>"); + start = expr.get_start (); + finish = parser->tokens_buf[0].location; + expr.value = build_array_ref (op_loc, expr.value, idx); + set_c_expr_source_range (&expr, start, finish); + expr.original_code = ERROR_MARK; + expr.original_type = NULL; + expr.m_decimal = 0; + } break; case CPP_OPEN_PAREN: /* Function call. */ @@ -11545,6 +11580,8 @@ c_parser_expr_list (c_parser *parser, bool convert_p, bool fold_p, vec *orig_types; struct c_expr expr; unsigned int idx = 0; + bool save_c_omp_array_section_p = c_omp_array_section_p; + c_omp_array_section_p = false; ret = make_tree_vector (); if (p_orig_types == NULL) @@ -11598,6 +11635,7 @@ c_parser_expr_list (c_parser *parser, bool convert_p, bool fold_p, } if (orig_types) *p_orig_types = orig_types; + c_omp_array_section_p = save_c_omp_array_section_p; return ret; } @@ -13825,7 +13863,7 @@ static tree c_parser_omp_variable_list (c_parser *parser, location_t clause_loc, enum omp_clause_code kind, tree list, - bool allow_deref = false) + bool map_lvalue = false) { auto_vec dims; bool array_section_p; @@ -13835,6 +13873,8 @@ c_parser_omp_variable_list (c_parser *parser, while (1) { + tree t = NULL_TREE; + if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) { if (c_parser_next_token_is_not (parser, CPP_NAME) @@ -13915,8 +13955,97 @@ c_parser_omp_variable_list (c_parser *parser, parser->tokens = tokens.address (); parser->tokens_avail = tokens.length (); } + else if (map_lvalue + && (kind == OMP_CLAUSE_MAP + || kind == OMP_CLAUSE_TO + || kind == OMP_CLAUSE_FROM)) + { + location_t loc = c_parser_peek_token (parser)->location; + bool save_c_omp_array_section_p = c_omp_array_section_p; + c_omp_array_section_p = true; + c_expr expr = c_parser_expr_no_commas (parser, NULL); + if (expr.value != error_mark_node) + mark_exp_read (expr.value); + c_omp_array_section_p = save_c_omp_array_section_p; + tree decl = expr.value; - tree t = NULL_TREE; + /* This code rewrites a parsed expression containing various tree + codes used to represent array accesses into a more uniform nest of + OMP_ARRAY_SECTION nodes before it is processed by + c-typeck.cc:handle_omp_array_sections_1. It might be more + efficient to move this logic to that function instead, analysing + the parsed expression directly rather than this preprocessed + form. (See also equivalent code in cp/parser.cc, + cp/semantics.cc). */ + dims.truncate (0); + if (TREE_CODE (decl) == OMP_ARRAY_SECTION) + { + while (TREE_CODE (decl) == OMP_ARRAY_SECTION) + { + tree low_bound = TREE_OPERAND (decl, 1); + tree length = TREE_OPERAND (decl, 2); + dims.safe_push (omp_dim (low_bound, length, loc, false)); + decl = TREE_OPERAND (decl, 0); + } + + while (TREE_CODE (decl) == ARRAY_REF + || TREE_CODE (decl) == INDIRECT_REF + || TREE_CODE (decl) == COMPOUND_EXPR) + { + if (TREE_CODE (decl) == COMPOUND_EXPR) + { + decl = TREE_OPERAND (decl, 1); + STRIP_NOPS (decl); + } + else if (TREE_CODE (decl) == INDIRECT_REF) + { + dims.safe_push (omp_dim (integer_zero_node, + integer_one_node, loc, true)); + decl = TREE_OPERAND (decl, 0); + } + else /* ARRAY_REF. */ + { + tree index = TREE_OPERAND (decl, 1); + dims.safe_push (omp_dim (index, integer_one_node, loc, + true)); + decl = TREE_OPERAND (decl, 0); + } + } + + for (int i = dims.length () - 1; i >= 0; i--) + decl = build_omp_array_section (loc, decl, dims[i].low_bound, + dims[i].length); + } + else if (TREE_CODE (decl) == INDIRECT_REF) + { + /* Turn *foo into the representation previously used for + foo[0]. */ + decl = TREE_OPERAND (decl, 0); + STRIP_NOPS (decl); + + decl = build_omp_array_section (loc, decl, integer_zero_node, + integer_one_node); + } + else if (TREE_CODE (decl) == ARRAY_REF) + { + tree idx = TREE_OPERAND (decl, 1); + + decl = TREE_OPERAND (decl, 0); + STRIP_NOPS (decl); + + decl = build_omp_array_section (loc, decl, idx, integer_one_node); + } + else if (TREE_CODE (decl) == NON_LVALUE_EXPR + || CONVERT_EXPR_P (decl)) + decl = TREE_OPERAND (decl, 0); + + tree u = build_omp_clause (clause_loc, kind); + OMP_CLAUSE_DECL (u) = decl; + OMP_CLAUSE_CHAIN (u) = list; + list = u; + + goto next_item; + } if (c_parser_next_token_is (parser, CPP_NAME) && c_parser_peek_token (parser)->id_kind == C_ID_ID) @@ -13967,8 +14096,7 @@ c_parser_omp_variable_list (c_parser *parser, case OMP_CLAUSE_TO: start_component_ref: while (c_parser_next_token_is (parser, CPP_DOT) - || (allow_deref - && c_parser_next_token_is (parser, CPP_DEREF))) + || c_parser_next_token_is (parser, CPP_DEREF)) { location_t op_loc = c_parser_peek_token (parser)->location; location_t arrow_loc = UNKNOWN_LOCATION; @@ -14069,9 +14197,7 @@ c_parser_omp_variable_list (c_parser *parser, || kind == OMP_CLAUSE_TO) && !array_section_p && (c_parser_next_token_is (parser, CPP_DOT) - || (allow_deref - && c_parser_next_token_is (parser, - CPP_DEREF)))) + || c_parser_next_token_is (parser, CPP_DEREF))) { for (unsigned i = 0; i < dims.length (); i++) { @@ -14083,7 +14209,9 @@ c_parser_omp_variable_list (c_parser *parser, } else for (unsigned i = 0; i < dims.length (); i++) - t = tree_cons (dims[i].low_bound, dims[i].length, t); + t = build_omp_array_section (clause_loc, t, + dims[i].low_bound, + dims[i].length); } if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) @@ -14131,6 +14259,8 @@ c_parser_omp_variable_list (c_parser *parser, parser->tokens = &parser->tokens_buf[0]; parser->tokens_avail = tokens_avail; } + + next_item: if (c_parser_next_token_is_not (parser, CPP_COMMA)) break; @@ -14147,7 +14277,7 @@ c_parser_omp_variable_list (c_parser *parser, static tree c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind, - tree list, bool allow_deref = false) + tree list, bool map_lvalue = false) { /* The clauses location. */ location_t loc = c_parser_peek_token (parser)->location; @@ -14155,7 +14285,7 @@ c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind, matching_parens parens; if (parens.require_open (parser)) { - list = c_parser_omp_variable_list (parser, loc, kind, list, allow_deref); + list = c_parser_omp_variable_list (parser, loc, kind, list, map_lvalue); parens.skip_until_found_close (parser); } return list; @@ -14224,7 +14354,7 @@ c_parser_oacc_data_clause (c_parser *parser, pragma_omp_clause c_kind, gcc_unreachable (); } tree nl, c; - nl = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_MAP, list, true); + nl = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_MAP, list, false); for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) OMP_CLAUSE_SET_MAP_KIND (c, kind); @@ -15814,13 +15944,15 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind, for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) { tree d = OMP_CLAUSE_DECL (c), type; - if (TREE_CODE (d) != TREE_LIST) + if (TREE_CODE (d) != OMP_ARRAY_SECTION) type = TREE_TYPE (d); else { int cnt = 0; tree t; - for (t = d; TREE_CODE (t) == TREE_LIST; t = TREE_CHAIN (t)) + for (t = d; + TREE_CODE (t) == OMP_ARRAY_SECTION; + t = TREE_OPERAND (t, 0)) cnt++; type = TREE_TYPE (t); while (cnt > 0) @@ -22479,6 +22611,7 @@ check_clauses: case GOMP_MAP_FIRSTPRIVATE_POINTER: case GOMP_MAP_ALWAYS_POINTER: case GOMP_MAP_ATTACH_DETACH: + case GOMP_MAP_ATTACH: break; default: error_at (OMP_CLAUSE_LOCATION (*pc), diff --git a/gcc/c/c-tree.h b/gcc/c/c-tree.h index 7c5234e80fd9..5cd507563695 100644 --- a/gcc/c/c-tree.h +++ b/gcc/c/c-tree.h @@ -726,6 +726,7 @@ extern int in_alignof; extern int in_sizeof; extern int in_typeof; extern bool c_in_omp_for; +extern bool c_omp_array_section_p; extern tree c_last_sizeof_arg; extern location_t c_last_sizeof_loc; @@ -764,6 +765,7 @@ extern tree composite_type (tree, tree); extern tree build_component_ref (location_t, tree, tree, location_t, location_t); extern tree build_array_ref (location_t, tree, tree); +extern tree build_omp_array_section (location_t, tree, tree, tree); extern tree build_external_ref (location_t, tree, bool, tree *); extern void pop_maybe_used (bool); extern struct c_expr c_expr_sizeof_expr (location_t, struct c_expr); diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc index 597b77181dc2..b399341084d2 100644 --- a/gcc/c/c-typeck.cc +++ b/gcc/c/c-typeck.cc @@ -76,6 +76,9 @@ int in_typeof; /* True when parsing OpenMP loop expressions. */ bool c_in_omp_for; +/* True when parsing OpenMP map clause. */ +bool c_omp_array_section_p; + /* The argument of last parsed sizeof expression, only to be tested if expr.original_code == SIZEOF_EXPR. */ tree c_last_sizeof_arg; @@ -2001,6 +2004,13 @@ mark_exp_read (tree exp) case C_MAYBE_CONST_EXPR: mark_exp_read (TREE_OPERAND (exp, 1)); break; + case OMP_ARRAY_SECTION: + mark_exp_read (TREE_OPERAND (exp, 0)); + if (TREE_OPERAND (exp, 1)) + mark_exp_read (TREE_OPERAND (exp, 1)); + if (TREE_OPERAND (exp, 2)) + mark_exp_read (TREE_OPERAND (exp, 2)); + break; default: break; } @@ -2878,6 +2888,53 @@ build_array_ref (location_t loc, tree array, tree index) return ret; } } + +/* Build an OpenMP array section reference, creating an exact type for the + resulting expression based on the element type and bounds if possible. If + we have variable bounds, create an incomplete array type for the result + instead. */ + +tree +build_omp_array_section (location_t loc, tree array, tree index, tree length) +{ + tree idxtype; + + if (index != NULL_TREE + && length != NULL_TREE + && INTEGRAL_TYPE_P (TREE_TYPE (index)) + && INTEGRAL_TYPE_P (TREE_TYPE (length))) + { + tree low = fold_convert (sizetype, index); + tree high = fold_convert (sizetype, length); + high = size_binop (PLUS_EXPR, low, high); + high = size_binop (MINUS_EXPR, high, size_one_node); + idxtype = build_range_type (sizetype, low, high); + } + else if ((index == NULL_TREE || integer_zerop (index)) + && length != NULL_TREE + && INTEGRAL_TYPE_P (TREE_TYPE (length))) + idxtype = build_index_type (length); + else + idxtype = NULL_TREE; + + tree type = TREE_TYPE (array); + gcc_assert (type); + + tree sectype, eltype = TREE_TYPE (type); + + /* It's not an array or pointer type. Just reuse the type of the original + expression as the type of the array section (an error will be raised + anyway, later). */ + if (eltype == NULL_TREE + || error_operand_p (eltype) + || error_operand_p (idxtype)) + sectype = TREE_TYPE (array); + else + sectype = build_array_type (eltype, idxtype); + + return build3_loc (loc, OMP_ARRAY_SECTION, sectype, array, index, length); +} + /* Build an external reference to identifier ID. FUN indicates whether this will be used for a function call. LOC is the source @@ -2917,7 +2974,11 @@ build_external_ref (location_t loc, tree id, bool fun, tree *type) return error_mark_node; } - if (TREE_TYPE (ref) == error_mark_node) + /* For an OpenMP map clause, we can get better diagnostics for decls with + unmappable types if we return the decl with an error_mark_node type, + rather than returning error_mark_node for the decl itself. */ + if (TREE_TYPE (ref) == error_mark_node + && !c_omp_array_section_p) return error_mark_node; if (TREE_UNAVAILABLE (ref)) @@ -13635,7 +13696,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, { tree ret, low_bound, length, type; bool openacc = (ort & C_ORT_ACC) != 0; - if (TREE_CODE (t) != TREE_LIST) + if (TREE_CODE (t) != OMP_ARRAY_SECTION) { if (error_operand_p (t)) return error_mark_node; @@ -13660,7 +13721,9 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, t = ai.unconverted_ref_origin (); if (t == error_mark_node) return error_mark_node; - if (!VAR_P (t) && TREE_CODE (t) != PARM_DECL) + if (!VAR_P (t) + && (ort == C_ORT_ACC || !EXPR_P (t)) + && TREE_CODE (t) != PARM_DECL) { if (DECL_P (t)) error_at (OMP_CLAUSE_LOCATION (c), @@ -13708,14 +13771,14 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, return ret; } - ret = handle_omp_array_sections_1 (c, TREE_CHAIN (t), types, + ret = handle_omp_array_sections_1 (c, TREE_OPERAND (t, 0), types, maybe_zero_len, first_non_one, ort); if (ret == error_mark_node || ret == NULL_TREE) return ret; type = TREE_TYPE (ret); - low_bound = TREE_PURPOSE (t); - length = TREE_VALUE (t); + low_bound = TREE_OPERAND (t, 1); + length = TREE_OPERAND (t, 2); if (low_bound == error_mark_node || length == error_mark_node) return error_mark_node; @@ -13908,7 +13971,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, tree lb = save_expr (low_bound); if (lb != low_bound) { - TREE_PURPOSE (t) = lb; + TREE_OPERAND (t, 1) = lb; low_bound = lb; } } @@ -13939,14 +14002,15 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, array-section-subscript, the array section could be non-contiguous. */ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY - && TREE_CODE (TREE_CHAIN (t)) == TREE_LIST) + && TREE_CODE (TREE_OPERAND (t, 0)) == OMP_ARRAY_SECTION) { /* If any prior dimension has a non-one length, then deem this array section as non-contiguous. */ - for (tree d = TREE_CHAIN (t); TREE_CODE (d) == TREE_LIST; - d = TREE_CHAIN (d)) + for (tree d = TREE_OPERAND (t, 0); + TREE_CODE (d) == OMP_ARRAY_SECTION; + d = TREE_OPERAND (d, 0)) { - tree d_length = TREE_VALUE (d); + tree d_length = TREE_OPERAND (d, 2); if (d_length == NULL_TREE || !integer_onep (d_length)) { error_at (OMP_CLAUSE_LOCATION (c), @@ -13969,7 +14033,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, tree lb = save_expr (low_bound); if (lb != low_bound) { - TREE_PURPOSE (t) = lb; + TREE_OPERAND (t, 1) = lb; low_bound = lb; } ret = build_array_ref (OMP_CLAUSE_LOCATION (c), ret, low_bound); @@ -14032,10 +14096,10 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) maybe_zero_len = true; for (i = num, t = OMP_CLAUSE_DECL (c); i > 0; - t = TREE_CHAIN (t)) + t = TREE_OPERAND (t, 0)) { - tree low_bound = TREE_PURPOSE (t); - tree length = TREE_VALUE (t); + tree low_bound = TREE_OPERAND (t, 1); + tree length = TREE_OPERAND (t, 2); i--; if (low_bound @@ -14441,8 +14505,8 @@ c_oacc_check_attachments (tree c) { tree t = OMP_CLAUSE_DECL (c); - while (TREE_CODE (t) == TREE_LIST) - t = TREE_CHAIN (t); + while (TREE_CODE (t) == OMP_ARRAY_SECTION) + t = TREE_OPERAND (t, 0); if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE) { @@ -14550,7 +14614,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) case OMP_CLAUSE_TASK_REDUCTION: need_implicitly_determined = true; t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { if (handle_omp_array_sections (c, ort)) { @@ -15171,7 +15235,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) } else last_iterators = NULL_TREE; - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { if (handle_omp_array_sections (c, ort)) remove = true; @@ -15281,7 +15345,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) auto_vec addr_tokens; t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { grp_start_p = pc; grp_sentinel = OMP_CLAUSE_CHAIN (c); @@ -15449,6 +15513,9 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) if (!VAR_P (t) && TREE_CODE (t) != PARM_DECL) { + if (ort != C_ORT_ACC && EXPR_P (t)) + break; + error_at (OMP_CLAUSE_LOCATION (c), "%qE is not a variable in %qs clause", t, omp_clause_code_name[OMP_CLAUSE_CODE (c)]); @@ -15677,7 +15744,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) case OMP_CLAUSE_HAS_DEVICE_ADDR: t = OMP_CLAUSE_DECL (c); - if (TREE_CODE (t) == TREE_LIST) + if (TREE_CODE (t) == OMP_ARRAY_SECTION) { if (handle_omp_array_sections (c, ort)) remove = true; diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-1.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-1.c new file mode 100644 index 000000000000..a2226ebf6429 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-1.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ + +int foo (int *ptr); + +int main() +{ + int arr[20]; + /* Reject array section as function argument. */ +#pragma omp target map(foo(arr[3:5])) +/* { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } */ +/* { dg-warning {passing argument 1 of 'foo' makes pointer from integer without a cast} "" { target *-*-* } .-2 } */ +/* { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-3 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-2.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-2.c new file mode 100644 index 000000000000..449487ad55d6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-2.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ + +int main() +{ + int arr[20]; + /* Reject array section in statement expression. */ +#pragma omp target map( ({ int x = 5; arr[0:x]; }) ) +/* { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } */ +/* { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-2 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-3.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-3.c new file mode 100644 index 000000000000..8be15ced8c06 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-3.c @@ -0,0 +1,24 @@ +/* { dg-do compile } */ + +struct S { + int *ptr; +}; + +int main() +{ + int arr[20]; + + /* Reject array section in compound initialiser. */ +#pragma omp target map( (struct S) { .ptr = (int *) arr[5:5] } ) +/* { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } */ +/* { dg-warning {cast to pointer from integer of different size} "" { target *-*-* } .-2 } */ +/* { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-3 } */ + { } + + /* ...and this is unsupported too (probably not useful anyway). */ +#pragma omp target map( (struct S) { .ptr = &arr[5] } ) +/* { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-1 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-4.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-4.c new file mode 100644 index 000000000000..b78cdfc8a13e --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-4.c @@ -0,0 +1,26 @@ +/* { dg-do compile } */ + +int x; + +int main() +{ + int arr[20]; + int *ptr; + /* "arr[1:10]" looks like it might be an expression of array type, hence + able to be indexed (again). This isn't allowed, though. */ +#pragma omp target map(arr[1:10][2]) +/* { dg-error {'arr\[1\]' does not have pointer or array type} "" { target *-*-* } .-1 } */ + { } +#pragma omp target map(arr[1:x][2]) +/* { dg-error {'arr\[1\]' does not have pointer or array type} "" { target *-*-* } .-1 } */ + { } + /* ...and nor is this. */ +#pragma omp target map(ptr[1:10][2]) +/* { dg-error {'\*\(ptr \+ [0-9]+\)' does not have pointer or array type} "" { target *-*-* } .-1 } */ + { } +#pragma omp target map(ptr[1:x][2]) +/* { dg-error {'\*\(ptr \+ [0-9]+\)' does not have pointer or array type} "" { target *-*-* } .-1 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-5.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-5.c new file mode 100644 index 000000000000..ae343464a19a --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-5.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ + +int partly = 0; + +int main() +{ + int arr[20]; +#pragma omp target map(partly ? arr[5:5] : arr) +/* { dg-error {expected '\]' before ':' token} "" { target *-*-* } .-1 } */ +/* { dg-warning {pointer/integer type mismatch in conditional expression} "" { target *-*-* } .-2 } */ +/* { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-3 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-6.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-6.c new file mode 100644 index 000000000000..bfca4f0fca3f --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-6.c @@ -0,0 +1,16 @@ +/* { dg-do compile } */ + +int x; + +int main() +{ + int arr[20]; +#pragma omp target map(arr[5:5] * 2) +/* { dg-error {invalid operands to binary \*} "" { target *-*-* } .-1 } */ + { } +#pragma omp target map(arr[x:5] * 2) +/* { dg-error {invalid operands to binary \*} "" { target *-*-* } .-1 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-7.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-7.c new file mode 100644 index 000000000000..1fd9e2b383a4 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-7.c @@ -0,0 +1,26 @@ +/* { dg-do compile } */ + +int x; + +struct T { + int arr[20]; +}; + +struct S { + struct T *tvec; +}; + +int main() +{ + struct S *s; + /* You can't use an array section like this. Make sure sensible errors are + reported. */ +#pragma omp target map(s->tvec[3:5].arr[0:20]) +/* { dg-error {'\(struct T \*\)&s->tvec\[3:5\]' is a pointer; did you mean to use '->'\?} "" { target *-*-* } .-1 } */ + { } +#pragma omp target map(s->tvec[5:x].arr[0:20]) +/* { dg-error {'\(struct T \*\)&s->tvec\[5:x\]' is a pointer; did you mean to use '->'\?} "" { target *-*-* } .-1 } */ + { } + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-8.c b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-8.c new file mode 100644 index 000000000000..f90eca1fa9fa --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/bad-array-section-c-8.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ + +int x; + +int main() +{ + int arr1[40]; + int arr2[40]; +#pragma omp target map(arr1[arr2[4:5]:arr2[6:7]]) +/* { dg-error {low bound 'arr2\[4:5\]' of array section does not have integral type} "" { target *-*-* } .-1 } */ + { } +#pragma omp target map(arr1[arr2[:1]:arr2[6:1]]) +/* { dg-error {low bound 'arr2\[:1\]' of array section does not have integral type} "" { target *-*-* } .-1 } */ + { } +#pragma omp target map(arr1[x:arr2[6:1]]) +/* { dg-error {length 'arr2\[6:1\]' of array section does not have integral type} "" { target *-*-* } .-1 } */ + { } + + return 0; +} + diff --git a/libgomp/testsuite/libgomp.c-c++-common/ind-base-4.c b/libgomp/testsuite/libgomp.c-c++-common/ind-base-4.c new file mode 100644 index 000000000000..91549ac4d245 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/ind-base-4.c @@ -0,0 +1,50 @@ +// { dg-do run } +// { dg-options "-fopenmp" } + +#include +#include + +typedef struct +{ + int x[10]; +} S; + +typedef struct +{ + S ***s; +} T; + +typedef struct +{ + T **t; +} U; + +void +foo (void) +{ + U *u = (U *) malloc (sizeof (U)); + T *real_t = (T *) malloc (sizeof (T)); + S *real_s = (S *) malloc (sizeof (S)); + T **t_pp = &real_t; + S **s_pp = &real_s; + S ***s_ppp = &s_pp; + u->t = t_pp; + (*u->t)->s = s_ppp; + for (int i = 0; i < 10; i++) + (**((*u->t)->s))->x[i] = 0; +#pragma omp target map(u->t, *u->t, (*u->t)->s, *(*u->t)->s, **(*u->t)->s, \ + (**(*u->t)->s)->x[0:10]) + for (int i = 0; i < 10; i++) + (**((*u->t)->s))->x[i] = i * 3; + for (int i = 0; i < 10; i++) + assert ((**((*u->t)->s))->x[i] == i * 3); + free (real_s); + free (real_t); + free (u); +} + +int main (int argc, char *argv[]) +{ + foo (); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/unary-ptr-1.c b/libgomp/testsuite/libgomp.c-c++-common/unary-ptr-1.c new file mode 100644 index 000000000000..3623b2695763 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/unary-ptr-1.c @@ -0,0 +1,16 @@ +#include + +int main (int argc, char *argv[]) +{ + int y = 0; + int *x = &y; + +#pragma omp target map(*x) + { + (*x)++; + } + + assert (y == 1); + + return 0; +} From patchwork Tue Sep 5 19:28:23 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830097 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=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 4RgFv60WhGz1yg7 for ; Wed, 6 Sep 2023 05:29:37 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BFA363856DF4 for ; Tue, 5 Sep 2023 19:29:34 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 9F1AF3856DC6; Tue, 5 Sep 2023 19:29:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 9F1AF3856DC6 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="6.02,229,1688457600"; d="scan'208";a="16179083" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:29:03 -0800 IronPort-SDR: 111guDmtmD4rE0IY+UG1dcYHcG3gieUkFqd9HNRLkug2XpJnvC1ut3WvkUNt0lJ4B5dMbGGPAR ef4/WCJBQilD5VWq8XPZplVbkRmzhtXAJN0g1f6bBv0sBHI4iThr6pA4WJvGPnl+8VodYAWyRA 4nvPha73Myt4Xqaf8lDBHHiB5q5g1gBNAQs66yURWGN98JFS6JHGj8d/8daPLCv6HFmluCcAPi +O9vdM9RmsVrw7TqfQ9X4rmwVascSnUGzn6RBU7qrECe6P3bNMDt7eDMDF+rQ8SFmG/NVfzay5 yU4= From: Julian Brown To: CC: , , Subject: [PATCH 3/8] OpenMP: C++ "declare mapper" support Date: Tue, 5 Sep 2023 12:28:23 -0700 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: 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.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP, URIBL_BLACK 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 Sender: "Gcc-patches" This patch adds support for OpenMP 5.0 "declare mapper" functionality for C++. This is based on the version of the patch posted for the og13 branch here: https://gcc.gnu.org/pipermail/gcc-patches/2023-June/623353.html The following follow up patches/fixes have also been incorporated into this version: "OpenMP: Expand "declare mapper" mappers for target {enter,exit,} data directives": https://gcc.gnu.org/pipermail/gcc-patches/2023-July/623780.html "OpenMP: Introduce C_ORT_{,OMP_}DECLARE_MAPPER c_omp_region_type types": https://gcc.gnu.org/pipermail/gcc-patches/2023-August/627005.html 2023-09-05 Julian Brown gcc/c-family/ * c-common.h (c_omp_region_type): Add C_ORT_EXIT_DATA, C_ORT_DECLARE_MAPPER, C_ORT_OMP_EXIT_DATA, C_ORT_OMP_DECLARE_MAPPER values. (omp_mapper_list): Add forward declaration. (c_omp_find_nested_mappers, c_omp_instantiate_mappers): Add prototypes. * c-omp.cc (c_omp_find_nested_mappers): New function. (remap_mapper_decl_info): New struct. (remap_mapper_decl_1, omp_split_map_kind, omp_join_map_kind, omp_map_decayed_kind, omp_instantiate_mapper, c_omp_instantiate_mappers): New functions. gcc/cp/ * constexpr.cc (reduced_constant_expression_p): Add OMP_DECLARE_MAPPER case. (cxx_eval_constant_expression, potential_constant_expression_1): Likewise. * cp-gimplify.cc (cxx_omp_finish_mapper_clauses): New function. * cp-objcp-common.h (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES, LANG_HOOKS_OMP_MAPPER_LOOKUP, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE, LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define langhooks. * cp-tree.h (lang_decl_base): Add omp_declare_mapper_p field. Recount spare bits comment. (DECL_OMP_DECLARE_MAPPER_P): New macro. (omp_mapper_id, cp_check_omp_declare_mapper, omp_instantiate_mappers, cxx_omp_finish_mapper_clauses, cxx_omp_mapper_lookup, cxx_omp_extract_mapper_directive, cxx_omp_map_array_section): Add prototypes. * decl.cc (check_initializer): Add OpenMP declare mapper support. (cp_finish_decl): Set DECL_INITIAL for OpenMP declare mapper var decls as appropriate. * decl2.cc (mark_used): Instantiate OpenMP "declare mapper" magic var decls. * error.cc (dump_omp_declare_mapper): New function. (dump_simple_decl): Use above. * parser.cc (cp_parser_omp_clause_map): Add KIND parameter. Support "mapper" modifier. (cp_parser_omp_all_clauses): Add KIND argument to cp_parser_omp_clause_map call. (cp_parser_omp_target): Call omp_instantiate_mappers before finish_omp_clauses. (cp_parser_omp_declare_mapper): New function. (cp_parser_omp_declare): Add "declare mapper" support. * pt.cc (tsubst_decl): Adjust name of "declare mapper" magic var decls once we know their type. (tsubst_omp_clauses): Call omp_instantiate_mappers before finish_omp_clauses, for target regions. (tsubst_expr): Support OMP_DECLARE_MAPPER nodes. (instantiate_decl): Instantiate initialiser (i.e definition) for OpenMP declare mappers. * semantics.cc (gimplify.h): Include. (omp_mapper_id, cxx_omp_mapper_lookup, cxx_omp_extract_mapper_directive, cxx_omp_map_array_section, cp_check_omp_declare_mapper): New functions. (finish_omp_clauses): Delete GOMP_MAP_PUSH_MAPPER_NAME and GOMP_MAP_POP_MAPPER_NAME artificial clauses. (omp_target_walk_data): Add MAPPERS field. (finish_omp_target_clauses_r): Scan for uses of struct/union/class type variables. (finish_omp_target_clauses): Create artificial mapper binding clauses for used structs/unions/classes in offload region. gcc/fortran/ * parse.cc (tree.h, fold-const.h, tree-hash-traits.h): Add includes (for additions to omp-general.h). gcc/ * gimplify.cc (gimplify_omp_ctx): Add IMPLICIT_MAPPERS field. (new_omp_context): Initialise IMPLICIT_MAPPERS hash map. (delete_omp_context): Delete IMPLICIT_MAPPERS hash map. (instantiate_mapper_info): New structs. (remap_mapper_decl_1, omp_mapper_copy_decl, omp_instantiate_mapper, omp_instantiate_implicit_mappers): New functions. (gimplify_scan_omp_clauses): Handle MAPPER_BINDING clauses. (gimplify_adjust_omp_clauses): Instantiate implicit declared mappers. (gimplify_omp_declare_mapper): New function. (gimplify_expr): Call above function. * langhooks-def.h (lhd_omp_finish_mapper_clauses, lhd_omp_mapper_lookup, lhd_omp_extract_mapper_directive, lhd_omp_map_array_section): Add prototypes. (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES, LANG_HOOKS_OMP_MAPPER_LOOKUP, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE, LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define macros. (LANG_HOOK_DECLS): Add above macros. * langhooks.cc (lhd_omp_finish_mapper_clauses, lhd_omp_mapper_lookup, lhd_omp_extract_mapper_directive, lhd_omp_map_array_section): New dummy functions. * langhooks.h (lang_hooks_for_decls): Add OMP_FINISH_MAPPER_CLAUSES, OMP_MAPPER_LOOKUP, OMP_EXTRACT_MAPPER_DIRECTIVE, OMP_MAP_ARRAY_SECTION hooks. * omp-general.h (omp_name_type): Add templatized struct, hash type traits (for omp_name_type specialization). (omp_mapper_list): Add struct. * tree-core.h (omp_clause_code): Add OMP_CLAUSE__MAPPER_BINDING_. * tree-pretty-print.cc (dump_omp_clause): Support GOMP_MAP_UNSET, GOMP_MAP_PUSH_MAPPER_NAME, GOMP_MAP_POP_MAPPER_NAME artificial mapping clauses. Support OMP_CLAUSE__MAPPER_BINDING_ and OMP_DECLARE_MAPPER. * tree.cc (omp_clause_num_ops, omp_clause_code_name): Add OMP_CLAUSE__MAPPER_BINDING_. * tree.def (OMP_DECLARE_MAPPER): New tree code. * tree.h (OMP_DECLARE_MAPPER_ID, OMP_DECLARE_MAPPER_DECL, OMP_DECLARE_MAPPER_CLAUSES): New defines. (OMP_CLAUSE__MAPPER_BINDING__ID, OMP_CLAUSE__MAPPER_BINDING__DECL, OMP_CLAUSE__MAPPER_BINDING__MAPPER): New defines. include/ * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_UNSET, GOMP_MAP_PUSH_MAPPER_NAME, GOMP_MAP_POP_MAPPER_NAME artificial mapping clause types. gcc/testsuite/ * c-c++-common/gomp/map-6.c: Update error scan output. * c-c++-common/gomp/declare-mapper-3.c: New test (only enabled for C++ for now). * c-c++-common/gomp/declare-mapper-4.c: Likewise. * c-c++-common/gomp/declare-mapper-5.c: Likewise. * c-c++-common/gomp/declare-mapper-6.c: Likewise. * c-c++-common/gomp/declare-mapper-7.c: Likewise. * c-c++-common/gomp/declare-mapper-8.c: Likewise. * c-c++-common/gomp/declare-mapper-9.c: Likewise. * c-c++-common/gomp/declare-mapper-12.c: Likewise. * c-c++-common/gomp/declare-mapper-15.c: Likewise. * c-c++-common/gomp/declare-mapper-16.c: Likewise. * g++.dg/gomp/declare-mapper-1.C: New test. * g++.dg/gomp/declare-mapper-2.C: New test. libgomp/ * testsuite/libgomp.c++/declare-mapper-1.C: New test. * testsuite/libgomp.c++/declare-mapper-2.C: New test. * testsuite/libgomp.c++/declare-mapper-3.C: New test. * testsuite/libgomp.c++/declare-mapper-4.C: New test. * testsuite/libgomp.c++/declare-mapper-5.C: New test. * testsuite/libgomp.c++/declare-mapper-6.C: New test. * testsuite/libgomp.c++/declare-mapper-7.C: New test. * testsuite/libgomp.c++/declare-mapper-8.C: New test. * testsuite/libgomp.c-c++-common/declare-mapper-9.c: New test (only enabled for C++ for now). * testsuite/libgomp.c-c++-common/declare-mapper-10.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-11.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-12.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-13.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-14.c: Likewise. --- gcc/c-family/c-common.h | 7 + gcc/c-family/c-omp.cc | 477 ++++++++++++++++++ gcc/cp/constexpr.cc | 9 + gcc/cp/cp-gimplify.cc | 6 + gcc/cp/cp-objcp-common.h | 9 + gcc/cp/cp-tree.h | 17 +- gcc/cp/decl.cc | 27 +- gcc/cp/decl2.cc | 9 +- gcc/cp/error.cc | 25 + gcc/cp/parser.cc | 305 ++++++++++- gcc/cp/pt.cc | 35 +- gcc/cp/semantics.cc | 191 ++++++- gcc/fortran/parse.cc | 3 + gcc/gimplify.cc | 263 ++++++++++ gcc/langhooks-def.h | 13 + gcc/langhooks.cc | 35 ++ gcc/langhooks.h | 16 + gcc/omp-general.h | 86 ++++ .../c-c++-common/gomp/declare-mapper-12.c | 22 + .../c-c++-common/gomp/declare-mapper-15.c | 59 +++ .../c-c++-common/gomp/declare-mapper-16.c | 39 ++ .../c-c++-common/gomp/declare-mapper-3.c | 30 ++ .../c-c++-common/gomp/declare-mapper-4.c | 78 +++ .../c-c++-common/gomp/declare-mapper-5.c | 26 + .../c-c++-common/gomp/declare-mapper-6.c | 23 + .../c-c++-common/gomp/declare-mapper-7.c | 29 ++ .../c-c++-common/gomp/declare-mapper-8.c | 43 ++ .../c-c++-common/gomp/declare-mapper-9.c | 34 ++ gcc/testsuite/c-c++-common/gomp/map-6.c | 10 +- gcc/testsuite/g++.dg/gomp/declare-mapper-1.C | 58 +++ gcc/testsuite/g++.dg/gomp/declare-mapper-2.C | 30 ++ gcc/tree-core.h | 4 + gcc/tree-pretty-print.cc | 41 ++ gcc/tree.cc | 2 + gcc/tree.def | 7 + gcc/tree.h | 19 + include/gomp-constants.h | 8 +- .../testsuite/libgomp.c++/declare-mapper-1.C | 87 ++++ .../testsuite/libgomp.c++/declare-mapper-2.C | 55 ++ .../testsuite/libgomp.c++/declare-mapper-3.C | 63 +++ .../testsuite/libgomp.c++/declare-mapper-4.C | 63 +++ .../testsuite/libgomp.c++/declare-mapper-5.C | 52 ++ .../testsuite/libgomp.c++/declare-mapper-6.C | 37 ++ .../testsuite/libgomp.c++/declare-mapper-7.C | 48 ++ .../testsuite/libgomp.c++/declare-mapper-8.C | 61 +++ .../libgomp.c-c++-common/declare-mapper-10.c | 60 +++ .../libgomp.c-c++-common/declare-mapper-11.c | 59 +++ .../libgomp.c-c++-common/declare-mapper-12.c | 87 ++++ .../libgomp.c-c++-common/declare-mapper-13.c | 55 ++ .../libgomp.c-c++-common/declare-mapper-14.c | 57 +++ .../libgomp.c-c++-common/declare-mapper-9.c | 62 +++ 51 files changed, 2907 insertions(+), 34 deletions(-) create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c create mode 100644 gcc/testsuite/g++.dg/gomp/declare-mapper-1.C create mode 100644 gcc/testsuite/g++.dg/gomp/declare-mapper-2.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-1.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-2.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-3.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-4.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-5.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-6.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-7.C create mode 100644 libgomp/testsuite/libgomp.c++/declare-mapper-8.C create mode 100644 libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h index 4d1a6b1db6b9..b4e49c7d0cbc 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -1275,8 +1275,12 @@ enum c_omp_region_type C_ORT_ACC = 1 << 1, C_ORT_DECLARE_SIMD = 1 << 2, C_ORT_TARGET = 1 << 3, + C_ORT_EXIT_DATA = 1 << 4, + C_ORT_DECLARE_MAPPER = 1 << 6, C_ORT_OMP_DECLARE_SIMD = C_ORT_OMP | C_ORT_DECLARE_SIMD, C_ORT_OMP_TARGET = C_ORT_OMP | C_ORT_TARGET, + C_ORT_OMP_EXIT_DATA = C_ORT_OMP | C_ORT_EXIT_DATA, + C_ORT_OMP_DECLARE_MAPPER = C_ORT_OMP | C_ORT_DECLARE_MAPPER, C_ORT_ACC_TARGET = C_ORT_ACC | C_ORT_TARGET }; @@ -1312,6 +1316,9 @@ extern enum omp_clause_defaultmap_kind c_omp_predetermined_mapping (tree); extern tree c_omp_check_context_selector (location_t, tree); extern void c_omp_mark_declare_variant (location_t, tree, tree); extern void c_omp_adjust_map_clauses (tree, bool); +template struct omp_mapper_list; +extern void c_omp_find_nested_mappers (struct omp_mapper_list *, tree); +extern tree c_omp_instantiate_mappers (tree, enum c_omp_region_type); namespace omp_addr_tokenizer { struct omp_addr_token; } typedef omp_addr_tokenizer::omp_addr_token omp_addr_token; diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc index 0d668925da11..b73f9682f460 100644 --- a/gcc/c-family/c-omp.cc +++ b/gcc/c-family/c-omp.cc @@ -3938,6 +3938,483 @@ c_omp_address_inspector::expand_map_clause (tree c, tree expr, return error_mark_node; } +/* Given a mapper function MAPPER_FN, recursively scan through the map clauses + for that mapper, and if any of those should use a (named or unnamed) mapper + themselves, add it to MLIST. */ + +void +c_omp_find_nested_mappers (omp_mapper_list *mlist, tree mapper_fn) +{ + tree mapper = lang_hooks.decls.omp_extract_mapper_directive (mapper_fn); + tree mapper_name = NULL_TREE; + + if (mapper == error_mark_node) + return; + + gcc_assert (TREE_CODE (mapper) == OMP_DECLARE_MAPPER); + + for (tree clause = OMP_DECLARE_MAPPER_CLAUSES (mapper); + clause; + clause = OMP_CLAUSE_CHAIN (clause)) + { + tree expr = OMP_CLAUSE_DECL (clause); + enum gomp_map_kind clause_kind = OMP_CLAUSE_MAP_KIND (clause); + tree elem_type; + + if (clause_kind == GOMP_MAP_PUSH_MAPPER_NAME) + { + mapper_name = expr; + continue; + } + else if (clause_kind == GOMP_MAP_POP_MAPPER_NAME) + { + mapper_name = NULL_TREE; + continue; + } + + gcc_assert (TREE_CODE (expr) != TREE_LIST); + if (TREE_CODE (expr) == OMP_ARRAY_SECTION) + { + while (TREE_CODE (expr) == OMP_ARRAY_SECTION) + expr = TREE_OPERAND (expr, 0); + + elem_type = TREE_TYPE (expr); + } + else + elem_type = TREE_TYPE (expr); + + /* This might be too much... or not enough? */ + while (TREE_CODE (elem_type) == ARRAY_TYPE + || TREE_CODE (elem_type) == POINTER_TYPE + || TREE_CODE (elem_type) == REFERENCE_TYPE) + elem_type = TREE_TYPE (elem_type); + + elem_type = TYPE_MAIN_VARIANT (elem_type); + + if (AGGREGATE_TYPE_P (elem_type) + && !mlist->contains (mapper_name, elem_type)) + { + tree nested_mapper_fn + = lang_hooks.decls.omp_mapper_lookup (mapper_name, elem_type); + + if (nested_mapper_fn) + { + mlist->add_mapper (mapper_name, elem_type, nested_mapper_fn); + c_omp_find_nested_mappers (mlist, nested_mapper_fn); + } + else if (mapper_name) + { + error ("mapper %qE not found for type %qT", mapper_name, + elem_type); + continue; + } + } + } +} + +struct remap_mapper_decl_info +{ + tree dummy_var; + tree expr; +}; + +/* Helper for rewriting DUMMY_VAR into EXPR in a map clause decl. */ + +static tree +remap_mapper_decl_1 (tree *tp, int *walk_subtrees, void *data) +{ + remap_mapper_decl_info *map_info = (remap_mapper_decl_info *) data; + + if (operand_equal_p (*tp, map_info->dummy_var)) + { + *tp = map_info->expr; + *walk_subtrees = 0; + } + + return NULL_TREE; +} + +static enum gomp_map_kind +omp_split_map_kind (enum gomp_map_kind op, bool *force_p, bool *always_p, + bool *present_p) +{ + *force_p = *always_p = *present_p = false; + + switch (op) + { + case GOMP_MAP_FORCE_ALLOC: + case GOMP_MAP_FORCE_TO: + case GOMP_MAP_FORCE_FROM: + case GOMP_MAP_FORCE_TOFROM: + case GOMP_MAP_FORCE_PRESENT: + *force_p = true; + break; + case GOMP_MAP_ALWAYS_TO: + case GOMP_MAP_ALWAYS_FROM: + case GOMP_MAP_ALWAYS_TOFROM: + *always_p = true; + break; + case GOMP_MAP_ALWAYS_PRESENT_TO: + case GOMP_MAP_ALWAYS_PRESENT_FROM: + case GOMP_MAP_ALWAYS_PRESENT_TOFROM: + *always_p = true; + /* Fallthrough. */ + case GOMP_MAP_PRESENT_ALLOC: + case GOMP_MAP_PRESENT_TO: + case GOMP_MAP_PRESENT_FROM: + case GOMP_MAP_PRESENT_TOFROM: + *present_p = true; + break; + default: + ; + } + + switch (op) + { + case GOMP_MAP_ALLOC: + case GOMP_MAP_FORCE_ALLOC: + case GOMP_MAP_PRESENT_ALLOC: + return GOMP_MAP_ALLOC; + case GOMP_MAP_TO: + case GOMP_MAP_FORCE_TO: + case GOMP_MAP_ALWAYS_TO: + case GOMP_MAP_PRESENT_TO: + case GOMP_MAP_ALWAYS_PRESENT_TO: + return GOMP_MAP_TO; + case GOMP_MAP_FROM: + case GOMP_MAP_FORCE_FROM: + case GOMP_MAP_ALWAYS_FROM: + case GOMP_MAP_PRESENT_FROM: + case GOMP_MAP_ALWAYS_PRESENT_FROM: + return GOMP_MAP_FROM; + case GOMP_MAP_TOFROM: + case GOMP_MAP_FORCE_TOFROM: + case GOMP_MAP_ALWAYS_TOFROM: + case GOMP_MAP_PRESENT_TOFROM: + case GOMP_MAP_ALWAYS_PRESENT_TOFROM: + return GOMP_MAP_TOFROM; + default: + ; + } + + return op; +} + +static enum gomp_map_kind +omp_join_map_kind (enum gomp_map_kind op, bool force_p, bool always_p, + bool present_p) +{ + gcc_assert (!force_p || !(always_p || present_p)); + + switch (op) + { + case GOMP_MAP_ALLOC: + if (force_p) + return GOMP_MAP_FORCE_ALLOC; + else if (present_p) + return GOMP_MAP_PRESENT_ALLOC; + break; + + case GOMP_MAP_TO: + if (force_p) + return GOMP_MAP_FORCE_TO; + else if (always_p && present_p) + return GOMP_MAP_ALWAYS_PRESENT_TO; + else if (always_p) + return GOMP_MAP_ALWAYS_TO; + else if (present_p) + return GOMP_MAP_PRESENT_TO; + break; + + case GOMP_MAP_FROM: + if (force_p) + return GOMP_MAP_FORCE_FROM; + else if (always_p && present_p) + return GOMP_MAP_ALWAYS_PRESENT_FROM; + else if (always_p) + return GOMP_MAP_ALWAYS_FROM; + else if (present_p) + return GOMP_MAP_PRESENT_FROM; + break; + + case GOMP_MAP_TOFROM: + if (force_p) + return GOMP_MAP_FORCE_TOFROM; + else if (always_p && present_p) + return GOMP_MAP_ALWAYS_PRESENT_TOFROM; + else if (always_p) + return GOMP_MAP_ALWAYS_TOFROM; + else if (present_p) + return GOMP_MAP_PRESENT_TOFROM; + break; + + default: + ; + } + + return op; +} + +/* Map kind decay (OpenMP 5.2, 5.8.8 "declare mapper Directive"). Return the + map kind to use given MAPPER_KIND specified in the mapper and INVOKED_AS + specified on the clause that invokes the mapper. See also + fortran/trans-openmp.cc:omp_map_decayed_kind. */ + +static enum gomp_map_kind +omp_map_decayed_kind (enum gomp_map_kind mapper_kind, + enum gomp_map_kind invoked_as, bool exit_p) +{ + if (invoked_as == GOMP_MAP_RELEASE || invoked_as == GOMP_MAP_DELETE) + return invoked_as; + + bool force_p, always_p, present_p; + + invoked_as = omp_split_map_kind (invoked_as, &force_p, &always_p, &present_p); + gomp_map_kind decay_to; + + switch (mapper_kind) + { + case GOMP_MAP_ALLOC: + if (exit_p && invoked_as == GOMP_MAP_FROM) + decay_to = GOMP_MAP_RELEASE; + else + decay_to = GOMP_MAP_ALLOC; + break; + + case GOMP_MAP_TO: + if (invoked_as == GOMP_MAP_FROM) + decay_to = exit_p ? GOMP_MAP_RELEASE : GOMP_MAP_ALLOC; + else if (invoked_as == GOMP_MAP_ALLOC) + decay_to = GOMP_MAP_ALLOC; + else + decay_to = GOMP_MAP_TO; + break; + + case GOMP_MAP_FROM: + if (invoked_as == GOMP_MAP_ALLOC || invoked_as == GOMP_MAP_TO) + decay_to = GOMP_MAP_ALLOC; + else + decay_to = GOMP_MAP_FROM; + break; + + case GOMP_MAP_TOFROM: + case GOMP_MAP_UNSET: + decay_to = invoked_as; + break; + + default: + gcc_unreachable (); + } + + return omp_join_map_kind (decay_to, force_p, always_p, present_p); +} + +/* Instantiate a mapper MAPPER for expression EXPR, adding new clauses to + OUTLIST. OUTER_KIND is the mapping kind to use if not already specified in + the mapper declaration. */ + +static tree * +omp_instantiate_mapper (location_t loc, tree *outlist, tree mapper, tree expr, + enum gomp_map_kind outer_kind, + enum c_omp_region_type ort) +{ + tree clauses = OMP_DECLARE_MAPPER_CLAUSES (mapper); + tree dummy_var = OMP_DECLARE_MAPPER_DECL (mapper); + tree mapper_name = NULL_TREE; + + remap_mapper_decl_info map_info; + map_info.dummy_var = dummy_var; + map_info.expr = expr; + + for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c)) + { + tree unshared = unshare_expr (c); + enum gomp_map_kind clause_kind = OMP_CLAUSE_MAP_KIND (c); + tree t = OMP_CLAUSE_DECL (unshared); + tree type = NULL_TREE; + bool nonunit_array_with_mapper = false; + + if (clause_kind == GOMP_MAP_PUSH_MAPPER_NAME) + { + mapper_name = t; + continue; + } + else if (clause_kind == GOMP_MAP_POP_MAPPER_NAME) + { + mapper_name = NULL_TREE; + continue; + } + + if (TREE_CODE (t) == OMP_ARRAY_SECTION) + { + tree t2 = lang_hooks.decls.omp_map_array_section (loc, t); + + if (t2 == t) + { + nonunit_array_with_mapper = true; + /* We'd want use the mapper for the element type if this worked: + look that one up. */ + type = TREE_TYPE (TREE_TYPE (t)); + } + else + { + t = t2; + type = TREE_TYPE (t); + } + } + else + type = TREE_TYPE (t); + + gcc_assert (type); + + if (type == error_mark_node) + continue; + + walk_tree (&unshared, remap_mapper_decl_1, &map_info, NULL); + + OMP_CLAUSE_LOCATION (unshared) = loc; + + enum gomp_map_kind decayed_kind + = omp_map_decayed_kind (clause_kind, outer_kind, + (ort & C_ORT_EXIT_DATA) != 0); + OMP_CLAUSE_SET_MAP_KIND (unshared, decayed_kind); + + type = TYPE_MAIN_VARIANT (type); + + tree mapper_fn = lang_hooks.decls.omp_mapper_lookup (mapper_name, type); + + if (mapper_fn && nonunit_array_with_mapper) + { + sorry ("user-defined mapper with non-unit length array section"); + continue; + } + else if (mapper_fn) + { + tree nested_mapper + = lang_hooks.decls.omp_extract_mapper_directive (mapper_fn); + if (nested_mapper != mapper) + { + outlist = omp_instantiate_mapper (loc, outlist, nested_mapper, + t, outer_kind, ort); + continue; + } + } + else if (mapper_name) + { + error ("mapper %qE not found for type %qT", mapper_name, type); + continue; + } + + *outlist = unshared; + outlist = &OMP_CLAUSE_CHAIN (unshared); + } + + return outlist; +} + +/* Given a list of CLAUSES, scan each clause and invoke a user-defined mapper + appropriate to the type of the data in that clause, if such a mapper is + visible in the current parsing context. */ + +tree +c_omp_instantiate_mappers (tree clauses, enum c_omp_region_type ort) +{ + tree c, *pc, mapper_name = NULL_TREE; + + for (pc = &clauses, c = clauses; c; c = *pc) + { + bool using_mapper = false; + + switch (OMP_CLAUSE_CODE (c)) + { + case OMP_CLAUSE_MAP: + { + tree t = OMP_CLAUSE_DECL (c); + tree type = NULL_TREE; + bool nonunit_array_with_mapper = false; + + if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POP_MAPPER_NAME) + { + if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME) + mapper_name = OMP_CLAUSE_DECL (c); + else + mapper_name = NULL_TREE; + pc = &OMP_CLAUSE_CHAIN (c); + continue; + } + + if (TREE_CODE (t) == OMP_ARRAY_SECTION) + { + location_t loc = OMP_CLAUSE_LOCATION (c); + tree t2 = lang_hooks.decls.omp_map_array_section (loc, t); + + if (t2 == t) + { + /* !!! Array sections of size >1 with mappers for elements + are hard to support. Do something here. */ + nonunit_array_with_mapper = true; + type = TREE_TYPE (TREE_TYPE (t)); + } + else + { + t = t2; + type = TREE_TYPE (t); + } + } + else + type = TREE_TYPE (t); + + if (type == NULL_TREE || type == error_mark_node) + { + pc = &OMP_CLAUSE_CHAIN (c); + continue; + } + + enum gomp_map_kind kind = OMP_CLAUSE_MAP_KIND (c); + if (kind == GOMP_MAP_UNSET) + kind = GOMP_MAP_TOFROM; + + type = TYPE_MAIN_VARIANT (type); + + tree mapper_fn + = lang_hooks.decls.omp_mapper_lookup (mapper_name, type); + + if (mapper_fn && nonunit_array_with_mapper) + { + sorry ("user-defined mapper with non-unit length " + "array section"); + using_mapper = true; + } + else if (mapper_fn) + { + tree mapper + = lang_hooks.decls.omp_extract_mapper_directive (mapper_fn); + pc = omp_instantiate_mapper (OMP_CLAUSE_LOCATION (c), + pc, mapper, t, kind, ort); + using_mapper = true; + } + else if (mapper_name) + { + error ("mapper %qE not found for type %qT", mapper_name, type); + using_mapper = true; + } + } + break; + + default: + ; + } + + if (using_mapper) + *pc = OMP_CLAUSE_CHAIN (c); + else + pc = &OMP_CLAUSE_CHAIN (c); + } + + return clauses; +} + const struct c_omp_directive c_omp_directives[] = { /* Keep this alphabetically sorted by the first word. Non-null second/third if any should precede null ones. */ diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc index 6eae8a50207f..455ab83d5162 100644 --- a/gcc/cp/constexpr.cc +++ b/gcc/cp/constexpr.cc @@ -3300,6 +3300,9 @@ reduced_constant_expression_p (tree t) /* Even if we can't lower this yet, it's constant. */ return true; + case OMP_DECLARE_MAPPER: + return true; + case CONSTRUCTOR: /* And we need to handle PTRMEM_CST wrapped in a CONSTRUCTOR. */ tree field; @@ -7160,6 +7163,7 @@ cxx_eval_constant_expression (const constexpr_ctx *ctx, tree t, case LABEL_EXPR: case CASE_LABEL_EXPR: case PREDICT_EXPR: + case OMP_DECLARE_MAPPER: return t; case PARM_DECL: @@ -9725,6 +9729,11 @@ potential_constant_expression_1 (tree t, bool want_rval, bool strict, bool now, "expression", t); return false; + case OMP_DECLARE_MAPPER: + /* This can be used to initialize VAR_DECLs: it's treated as a magic + constant. */ + return true; + case ASM_EXPR: if (flags & tf_error) inline_asm_in_constexpr_error (loc, fundef_p); diff --git a/gcc/cp/cp-gimplify.cc b/gcc/cp/cp-gimplify.cc index 206e791fcfd7..8d006d2e33c7 100644 --- a/gcc/cp/cp-gimplify.cc +++ b/gcc/cp/cp-gimplify.cc @@ -2405,6 +2405,12 @@ cxx_omp_finish_clause (tree c, gimple_seq *, bool /* openacc */) } } +tree +cxx_omp_finish_mapper_clauses (tree clauses) +{ + return finish_omp_clauses (clauses, C_ORT_OMP); +} + /* Return true if DECL's DECL_VALUE_EXPR (if any) should be disregarded in OpenMP construct, because it is going to be remapped during OpenMP lowering. SHARED is true if DECL diff --git a/gcc/cp/cp-objcp-common.h b/gcc/cp/cp-objcp-common.h index 80893aa17520..3182b6a2c908 100644 --- a/gcc/cp/cp-objcp-common.h +++ b/gcc/cp/cp-objcp-common.h @@ -184,6 +184,15 @@ extern tree cxx_simulate_record_decl (location_t, const char *, #define LANG_HOOKS_OMP_CLAUSE_DTOR cxx_omp_clause_dtor #undef LANG_HOOKS_OMP_FINISH_CLAUSE #define LANG_HOOKS_OMP_FINISH_CLAUSE cxx_omp_finish_clause +#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES +#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES cxx_omp_finish_mapper_clauses +#undef LANG_HOOKS_OMP_MAPPER_LOOKUP +#define LANG_HOOKS_OMP_MAPPER_LOOKUP cxx_omp_mapper_lookup +#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE +#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \ + cxx_omp_extract_mapper_directive +#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION +#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION cxx_omp_map_array_section #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE cxx_omp_privatize_by_reference #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index eaec574efbe8..d2561fee8092 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -2878,7 +2878,10 @@ struct GTY(()) lang_decl_base { /* VAR_DECL or FUNCTION_DECL has keyed decls. */ unsigned module_keyed_decls_p : 1; - /* 12 spare bits. */ + /* VAR_DECL being used to represent an OpenMP declared mapper. */ + unsigned omp_declare_mapper_p : 1; + + /* 10 spare bits. */ }; /* True for DECL codes which have template info and access. */ @@ -4369,6 +4372,11 @@ get_vec_init_expr (tree t) #define DECL_OMP_DECLARE_REDUCTION_P(NODE) \ (LANG_DECL_FN_CHECK (DECL_COMMON_CHECK (NODE))->omp_declare_reduction_p) +/* Nonzero if NODE is an artificial VAR_DECL for + #pragma omp declare mapper. */ +#define DECL_OMP_DECLARE_MAPPER_P(NODE) \ + (DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))->u.base.omp_declare_mapper_p) + /* Nonzero if DECL has been declared threadprivate by #pragma omp threadprivate. */ #define CP_DECL_THREADPRIVATE_P(DECL) \ @@ -7750,10 +7758,13 @@ extern tree finish_qualified_id_expr (tree, tree, bool, bool, extern void simplify_aggr_init_expr (tree *); extern void finalize_nrv (tree, tree); extern tree omp_reduction_id (enum tree_code, tree, tree); +extern tree omp_mapper_id (tree, tree); extern tree cp_remove_omp_priv_cleanup_stmt (tree *, int *, void *); extern bool cp_check_omp_declare_reduction (tree); +extern bool cp_check_omp_declare_mapper (tree); extern void finish_omp_declare_simd_methods (tree); extern tree finish_omp_clauses (tree, enum c_omp_region_type); +extern tree omp_instantiate_mappers (tree); extern tree push_omp_privatization_clauses (bool); extern void pop_omp_privatization_clauses (tree); extern void save_omp_privatization_clauses (vec &); @@ -8338,6 +8349,10 @@ extern tree cxx_omp_clause_copy_ctor (tree, tree, tree); extern tree cxx_omp_clause_assign_op (tree, tree, tree); extern tree cxx_omp_clause_dtor (tree, tree); extern void cxx_omp_finish_clause (tree, gimple_seq *, bool); +extern tree cxx_omp_finish_mapper_clauses (tree); +extern tree cxx_omp_mapper_lookup (tree, tree); +extern tree cxx_omp_extract_mapper_directive (tree); +extern tree cxx_omp_map_array_section (location_t, tree); extern bool cxx_omp_privatize_by_reference (const_tree); extern bool cxx_omp_disregard_value_expr (tree, bool); extern void cp_fold_function (tree); diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc index 792ab330dd05..6779de0fb7a6 100644 --- a/gcc/cp/decl.cc +++ b/gcc/cp/decl.cc @@ -7441,6 +7441,12 @@ check_initializer (tree decl, tree init, int flags, vec **cleanups) } else if (!init && DECL_REALLY_EXTERN (decl)) ; + else if (flag_openmp + && VAR_P (decl) + && DECL_LANG_SPECIFIC (decl) + && DECL_OMP_DECLARE_MAPPER_P (decl) + && TREE_CODE (init) == OMP_DECLARE_MAPPER) + return NULL_TREE; else if (init || type_build_ctor_call (type) || TYPE_REF_P (type)) { @@ -8604,14 +8610,23 @@ cp_finish_decl (tree decl, tree init, bool init_const_expr_p, varpool_node::get_create (decl); } + if (flag_openmp + && VAR_P (decl) + && DECL_LANG_SPECIFIC (decl) + && DECL_OMP_DECLARE_MAPPER_P (decl) + && init) + { + gcc_assert (TREE_CODE (init) == OMP_DECLARE_MAPPER); + DECL_INITIAL (decl) = init; + } /* Convert the initializer to the type of DECL, if we have not already initialized DECL. */ - if (!DECL_INITIALIZED_P (decl) - /* If !DECL_EXTERNAL then DECL is being defined. In the - case of a static data member initialized inside the - class-specifier, there can be an initializer even if DECL - is *not* defined. */ - && (!DECL_EXTERNAL (decl) || init)) + else if (!DECL_INITIALIZED_P (decl) + /* If !DECL_EXTERNAL then DECL is being defined. In the + case of a static data member initialized inside the + class-specifier, there can be an initializer even if DECL + is *not* defined. */ + && (!DECL_EXTERNAL (decl) || init)) { cleanups = make_tree_vector (); init = check_initializer (decl, init, flags, &cleanups); diff --git a/gcc/cp/decl2.cc b/gcc/cp/decl2.cc index 2083d3b7b047..aec54702f06a 100644 --- a/gcc/cp/decl2.cc +++ b/gcc/cp/decl2.cc @@ -5821,10 +5821,15 @@ mark_used (tree decl, tsubst_flags_t complain /* = tf_warning_or_error */) /* If DECL has a deduced return type, we need to instantiate it now to find out its type. For OpenMP user defined reductions, we need them - instantiated for reduction clauses which inline them by hand directly. */ + instantiated for reduction clauses which inline them by hand directly. + OpenMP declared mappers are used implicitly so must be instantiated + before they can be detected. */ if (undeduced_auto_decl (decl) || (TREE_CODE (decl) == FUNCTION_DECL - && DECL_OMP_DECLARE_REDUCTION_P (decl))) + && DECL_OMP_DECLARE_REDUCTION_P (decl)) + || (TREE_CODE (decl) == VAR_DECL + && DECL_LANG_SPECIFIC (decl) + && DECL_OMP_DECLARE_MAPPER_P (decl))) maybe_instantiate_decl (decl); if (processing_template_decl || in_template_context) diff --git a/gcc/cp/error.cc b/gcc/cp/error.cc index c3082d46dbfe..68692a0b80f3 100644 --- a/gcc/cp/error.cc +++ b/gcc/cp/error.cc @@ -1137,12 +1137,37 @@ dump_global_iord (cxx_pretty_printer *pp, tree t) pp_printf (pp, p, DECL_SOURCE_FILE (t)); } +/* Write a representation of OpenMP "declare mapper" T to PP in a manner + suitable for error messages. */ + +static void +dump_omp_declare_mapper (cxx_pretty_printer *pp, tree t, int flags) +{ + pp_string (pp, "#pragma omp declare mapper"); + if (t == NULL_TREE || t == error_mark_node) + return; + pp_space (pp); + pp_cxx_left_paren (pp); + if (OMP_DECLARE_MAPPER_ID (t)) + { + pp_cxx_tree_identifier (pp, OMP_DECLARE_MAPPER_ID (t)); + pp_colon (pp); + } + dump_type (pp, TREE_TYPE (t), flags); + pp_cxx_right_paren (pp); +} + static void dump_simple_decl (cxx_pretty_printer *pp, tree t, tree type, int flags) { if (VAR_P (t) && DECL_NTTP_OBJECT_P (t)) return dump_expr (pp, DECL_INITIAL (t), flags); + if (TREE_CODE (t) == VAR_DECL + && DECL_LANG_SPECIFIC (t) + && DECL_OMP_DECLARE_MAPPER_P (t)) + return dump_omp_declare_mapper (pp, DECL_INITIAL (t), flags); + if (flags & TFF_DECL_SPECIFIERS) { if (concept_definition_p (t)) diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 2186d4a65f42..d2de6d480f1f 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -40726,13 +40726,12 @@ cp_parser_omp_clause_from_to (cp_parser *parser, enum omp_clause_code kind, map ( [map-type-modifier[,] ...] map-kind: variable-list ) map-type-modifier: - always | close */ + always | close | mapper ( mapper-name ) */ static tree -cp_parser_omp_clause_map (cp_parser *parser, tree list) +cp_parser_omp_clause_map (cp_parser *parser, tree list, enum gomp_map_kind kind) { tree nlist, c; - enum gomp_map_kind kind = GOMP_MAP_TOFROM; if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN)) return list; @@ -40750,12 +40749,17 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list) if (cp_lexer_peek_nth_token (parser->lexer, pos + 1)->type == CPP_COMMA) pos++; + else if (cp_lexer_peek_nth_token (parser->lexer, pos + 1)->type + == CPP_OPEN_PAREN) + pos = cp_parser_skip_balanced_tokens (parser, pos + 1); pos++; } bool always_modifier = false; bool close_modifier = false; bool present_modifier = false; + bool mapper_modifier = false; + tree mapper_name = NULL_TREE; for (int pos = 1; pos < map_kind_pos; ++pos) { cp_token *tok = cp_lexer_peek_token (parser->lexer); @@ -40778,6 +40782,7 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list) return list; } always_modifier = true; + cp_lexer_consume_token (parser->lexer); } else if (strcmp ("close", p) == 0) { @@ -40791,6 +40796,71 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list) return list; } close_modifier = true; + cp_lexer_consume_token (parser->lexer); + } + else if (strcmp ("mapper", p) == 0) + { + cp_lexer_consume_token (parser->lexer); + + matching_parens parens; + if (parens.require_open (parser)) + { + if (mapper_modifier) + { + cp_parser_error (parser, "too many % modifiers"); + /* Assume it's a well-formed mapper modifier, even if it + seems to be in the wrong place. */ + cp_lexer_consume_token (parser->lexer); + parens.require_close (parser); + cp_parser_skip_to_closing_parenthesis (parser, + /*recovering=*/true, + /*or_comma=*/false, + /*consume_paren=*/ + true); + return list; + } + + tok = cp_lexer_peek_token (parser->lexer); + switch (tok->type) + { + case CPP_NAME: + { + cp_expr e = cp_parser_identifier (parser); + if (e != error_mark_node) + mapper_name = e; + else + goto err; + } + break; + + case CPP_KEYWORD: + if (tok->keyword == RID_DEFAULT) + { + cp_lexer_consume_token (parser->lexer); + break; + } + /* Fallthrough. */ + + default: + err: + cp_parser_error (parser, + "expected identifier or %"); + return list; + } + + if (!parens.require_close (parser)) + { + cp_parser_skip_to_closing_parenthesis (parser, + /*recovering=*/true, + /*or_comma=*/false, + /*consume_paren=*/ + true); + return list; + } + + mapper_modifier = true; + pos += 3; + } } else if (strcmp ("present", p) == 0) { @@ -40804,19 +40874,19 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list) return list; } present_modifier = true; - } + cp_lexer_consume_token (parser->lexer); + } else { - cp_parser_error (parser, "% clause with map-type modifier other" - " than %, % or %"); + cp_parser_error (parser, "% clause with map-type modifier " + "other than %, %, " + "% or %"); cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true, /*or_comma=*/false, /*consume_paren=*/true); return list; } - - cp_lexer_consume_token (parser->lexer); } if (cp_lexer_next_token_is (parser->lexer, CPP_NAME) @@ -40872,8 +40942,30 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list) NULL, true); finish_scope (); + tree last_new = NULL_TREE; + for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c)) - OMP_CLAUSE_SET_MAP_KIND (c, kind); + { + OMP_CLAUSE_SET_MAP_KIND (c, kind); + last_new = c; + } + + if (mapper_name) + { + tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = mapper_name; + OMP_CLAUSE_CHAIN (name) = nlist; + nlist = name; + + gcc_assert (last_new); + + name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = null_pointer_node; + OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new); + OMP_CLAUSE_CHAIN (last_new) = name; + } return nlist; } @@ -41684,7 +41776,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask, c_name = "detach"; break; case PRAGMA_OMP_CLAUSE_MAP: - clauses = cp_parser_omp_clause_map (parser, clauses); + clauses = cp_parser_omp_clause_map (parser, clauses, GOMP_MAP_TOFROM); c_name = "map"; break; case PRAGMA_OMP_CLAUSE_DEVICE: @@ -45472,7 +45564,10 @@ cp_parser_omp_target_data (cp_parser *parser, cp_token *pragma_tok, bool *if_p) tree clauses = cp_parser_omp_all_clauses (parser, OMP_TARGET_DATA_CLAUSE_MASK, - "#pragma omp target data", pragma_tok); + "#pragma omp target data", pragma_tok, false); + if (!processing_template_decl) + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP); + clauses = finish_omp_clauses (clauses, C_ORT_OMP); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -45586,7 +45681,11 @@ cp_parser_omp_target_enter_data (cp_parser *parser, cp_token *pragma_tok, tree clauses = cp_parser_omp_all_clauses (parser, OMP_TARGET_ENTER_DATA_CLAUSE_MASK, - "#pragma omp target enter data", pragma_tok); + "#pragma omp target enter data", pragma_tok, + false); + if (!processing_template_decl) + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP); + clauses = finish_omp_clauses (clauses, C_ORT_OMP); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -45701,7 +45800,11 @@ cp_parser_omp_target_exit_data (cp_parser *parser, cp_token *pragma_tok, tree clauses = cp_parser_omp_all_clauses (parser, OMP_TARGET_EXIT_DATA_CLAUSE_MASK, - "#pragma omp target exit data", pragma_tok); + "#pragma omp target exit data", pragma_tok, + false); + if (!processing_template_decl) + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_EXIT_DATA); + clauses = finish_omp_clauses (clauses, C_ORT_OMP_EXIT_DATA); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -45993,6 +46096,8 @@ cp_parser_omp_target (cp_parser *parser, cp_token *pragma_tok, OMP_CLAUSE_CHAIN (nc) = OMP_CLAUSE_CHAIN (c); OMP_CLAUSE_CHAIN (c) = nc; } + if (!processing_template_decl) + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_TARGET); clauses = finish_omp_clauses (clauses, C_ORT_OMP_TARGET); c_omp_adjust_map_clauses (clauses, true); @@ -48251,6 +48356,172 @@ cp_parser_omp_declare_reduction (cp_parser *parser, cp_token *pragma_tok, obstack_free (&declarator_obstack, p); } +/* OpenMP 5.0 + #pragma omp declare mapper([mapper-identifier:]type var) \ + [clause[[,] clause] ... ] new-line */ + +static void +cp_parser_omp_declare_mapper (cp_parser *parser, cp_token *pragma_tok, + enum pragma_context) +{ + cp_token *token = NULL; + tree type = NULL_TREE, vardecl = NULL_TREE, block = NULL_TREE; + bool block_scope = false; + /* Don't create location wrapper nodes within "declare mapper" + directives. */ + auto_suppress_location_wrappers sentinel; + tree mapper_name = NULL_TREE; + tree mapper_id, id, placeholder, mapper, maplist = NULL_TREE; + + if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN)) + goto fail; + + if (current_function_decl) + block_scope = true; + + token = cp_lexer_peek_token (parser->lexer); + + if (cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON)) + { + switch (token->type) + { + case CPP_NAME: + { + cp_expr e = cp_parser_identifier (parser); + if (e != error_mark_node) + mapper_name = e; + else + goto fail; + } + break; + + case CPP_KEYWORD: + if (token->keyword == RID_DEFAULT) + { + mapper_name = NULL_TREE; + cp_lexer_consume_token (parser->lexer); + break; + } + /* Fallthrough. */ + + default: + cp_parser_error (parser, "expected identifier or %"); + } + + if (!cp_parser_require (parser, CPP_COLON, RT_COLON)) + goto fail; + } + + { + const char *saved_message = parser->type_definition_forbidden_message; + parser->type_definition_forbidden_message + = G_("types may not be defined within %"); + type_id_in_expr_sentinel s (parser); + type = cp_parser_type_id (parser); + parser->type_definition_forbidden_message = saved_message; + } + + if (dependent_type_p (type)) + mapper_id = omp_mapper_id (mapper_name, NULL_TREE); + else + mapper_id = omp_mapper_id (mapper_name, type); + + vardecl = build_lang_decl (VAR_DECL, mapper_id, type); + DECL_ARTIFICIAL (vardecl) = 1; + TREE_STATIC (vardecl) = 1; + TREE_PUBLIC (vardecl) = 0; + DECL_EXTERNAL (vardecl) = 0; + DECL_DECLARED_CONSTEXPR_P (vardecl) = 1; + DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P (vardecl) = 1; + DECL_OMP_DECLARE_MAPPER_P (vardecl) = 1; + + keep_next_level (true); + block = begin_omp_structured_block (); + + if (block_scope) + DECL_CONTEXT (vardecl) = current_function_decl; + else if (current_class_type) + DECL_CONTEXT (vardecl) = current_class_type; + else + DECL_CONTEXT (vardecl) = current_namespace; + + if (processing_template_decl) + vardecl = push_template_decl (vardecl); + + id = cp_parser_declarator_id (parser, false); + + if (!cp_parser_require (parser, CPP_CLOSE_PAREN, RT_CLOSE_PAREN)) + { + finish_omp_structured_block (block); + goto fail; + } + + placeholder = build_lang_decl (VAR_DECL, id, type); + DECL_CONTEXT (placeholder) = DECL_CONTEXT (vardecl); + if (processing_template_decl) + placeholder = push_template_decl (placeholder); + pushdecl (placeholder); + cp_finish_decl (placeholder, NULL_TREE, 0, NULL_TREE, 0); + DECL_ARTIFICIAL (placeholder) = 1; + TREE_USED (placeholder) = 1; + + while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL)) + { + pragma_omp_clause c_kind = cp_parser_omp_clause_name (parser); + if (c_kind != PRAGMA_OMP_CLAUSE_MAP) + { + if (c_kind != PRAGMA_OMP_CLAUSE_NONE) + cp_parser_error (parser, "unexpected clause"); + finish_omp_structured_block (block); + goto fail; + } + maplist = cp_parser_omp_clause_map (parser, maplist, GOMP_MAP_UNSET); + if (maplist == NULL_TREE) + break; + } + + if (maplist == NULL_TREE) + { + cp_parser_error (parser, "missing % clause"); + finish_omp_structured_block (block); + goto fail; + } + + mapper = make_node (OMP_DECLARE_MAPPER); + TREE_TYPE (mapper) = type; + OMP_DECLARE_MAPPER_ID (mapper) = mapper_name; + OMP_DECLARE_MAPPER_DECL (mapper) = placeholder; + OMP_DECLARE_MAPPER_CLAUSES (mapper) = maplist; + + finish_omp_structured_block (block); + + DECL_INITIAL (vardecl) = mapper; + + if (current_class_type) + { + if (processing_template_decl) + { + retrofit_lang_decl (vardecl); + SET_DECL_VAR_DECLARED_INLINE_P (vardecl); + } + finish_static_data_member_decl (vardecl, mapper, + /*init_const_expr_p=*/true, NULL_TREE, 0); + finish_member_declaration (vardecl); + } + else if (processing_template_decl && block_scope) + add_decl_expr (vardecl); + else + pushdecl (vardecl); + + cp_check_omp_declare_mapper (vardecl); + + cp_parser_require_pragma_eol (parser, pragma_tok); + return; + +fail: + cp_parser_skip_to_pragma_eol (parser, pragma_tok); +} + /* OpenMP 4.0 #pragma omp declare simd declare-simd-clauses[optseq] new-line #pragma omp declare reduction (reduction-id : typename-list : expression) \ @@ -48291,6 +48562,12 @@ cp_parser_omp_declare (cp_parser *parser, cp_token *pragma_tok, context); return false; } + if (strcmp (p, "mapper") == 0) + { + cp_lexer_consume_token (parser->lexer); + cp_parser_omp_declare_mapper (parser, pragma_tok, context); + return false; + } if (!flag_openmp) /* flag_openmp_simd */ { cp_parser_skip_to_pragma_eol (parser, pragma_tok); @@ -48304,7 +48581,7 @@ cp_parser_omp_declare (cp_parser *parser, cp_token *pragma_tok, } } cp_parser_error (parser, "expected %, %, " - "% or %"); + "%, % or %"); cp_parser_require_pragma_eol (parser, pragma_tok); return false; } diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index 68963d12b3d7..a1dadf4dd461 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -15479,6 +15479,13 @@ tsubst_decl (tree t, tree args, tsubst_flags_t complain, TYPE_ALIGN (TREE_TYPE (t))); } + if (flag_openmp + && VAR_P (t) + && DECL_LANG_SPECIFIC (t) + && DECL_OMP_DECLARE_MAPPER_P (t) + && strchr (IDENTIFIER_POINTER (DECL_NAME (t)), '~') == NULL) + DECL_NAME (r) = omp_mapper_id (DECL_NAME (t), TREE_TYPE (r)); + layout_decl (r, 0); } break; @@ -18312,8 +18319,10 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort, } new_clauses = nreverse (new_clauses); - if (ort != C_ORT_OMP_DECLARE_SIMD) + if (ort != C_ORT_OMP_DECLARE_SIMD && ort != C_ORT_OMP_DECLARE_MAPPER) { + if (ort & C_ORT_OMP) + new_clauses = c_omp_instantiate_mappers (new_clauses, ort); new_clauses = finish_omp_clauses (new_clauses, ort); if (linear_no_step) for (nc = new_clauses; nc; nc = OMP_CLAUSE_CHAIN (nc)) @@ -19732,7 +19741,9 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl) case OMP_TARGET_UPDATE: case OMP_TARGET_ENTER_DATA: case OMP_TARGET_EXIT_DATA: - tmp = tsubst_omp_clauses (OMP_STANDALONE_CLAUSES (t), C_ORT_OMP, args, + tmp = tsubst_omp_clauses (OMP_STANDALONE_CLAUSES (t), + (TREE_CODE (t) == OMP_TARGET_EXIT_DATA + ? C_ORT_OMP_EXIT_DATA : C_ORT_OMP), args, complain, in_decl); t = copy_node (t); OMP_STANDALONE_CLAUSES (t) = tmp; @@ -19880,6 +19891,22 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl) } break; + case OMP_DECLARE_MAPPER: + { + t = copy_node (t); + + tree decl = OMP_DECLARE_MAPPER_DECL (t); + decl = tsubst (decl, args, complain, in_decl); + tree type = tsubst (TREE_TYPE (t), args, complain, in_decl); + tree clauses = OMP_DECLARE_MAPPER_CLAUSES (t); + clauses = tsubst_omp_clauses (clauses, C_ORT_OMP_DECLARE_MAPPER, args, + complain, in_decl); + TREE_TYPE (t) = type; + OMP_DECLARE_MAPPER_DECL (t) = decl; + OMP_DECLARE_MAPPER_CLAUSES (t) = clauses; + RETURN (t); + } + case TRANSACTION_EXPR: { int flags = 0; @@ -27248,7 +27275,9 @@ instantiate_decl (tree d, bool defer_ok, bool expl_inst_class_mem_p) || (external_p && VAR_P (d)) /* Handle here a deleted function too, avoid generating its body (c++/61080). */ - || deleted_p) + || deleted_p + /* We need the initializer for an OpenMP declare mapper. */ + || (VAR_P (d) && DECL_LANG_SPECIFIC (d) && DECL_OMP_DECLARE_MAPPER_P (d))) { /* The definition of the static data member is now required so we must substitute the initializer. */ diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc index e182914266f3..d6f2da65410f 100644 --- a/gcc/cp/semantics.cc +++ b/gcc/cp/semantics.cc @@ -45,6 +45,7 @@ along with GCC; see the file COPYING3. If not see #include "gomp-constants.h" #include "predict.h" #include "memmodel.h" +#include "gimplify.h" /* There routines provide a modular interface to perform many parsing operations. They may therefore be used during actual parsing, or @@ -6077,6 +6078,101 @@ omp_reduction_lookup (location_t loc, tree id, tree type, tree *baselinkp, return id; } +/* Return identifier to look up for omp declare mapper. */ + +tree +omp_mapper_id (tree mapper_id, tree type) +{ + const char *p = NULL; + const char *m = NULL; + + if (mapper_id == NULL_TREE) + p = ""; + else if (TREE_CODE (mapper_id) == IDENTIFIER_NODE) + p = IDENTIFIER_POINTER (mapper_id); + else + return error_mark_node; + + if (type != NULL_TREE) + m = mangle_type_string (TYPE_MAIN_VARIANT (type)); + + const char prefix[] = "omp declare mapper "; + size_t lenp = sizeof (prefix); + if (strncmp (p, prefix, lenp - 1) == 0) + lenp = 1; + size_t len = strlen (p); + size_t lenm = m ? strlen (m) + 1 : 0; + char *name = XALLOCAVEC (char, lenp + len + lenm); + memcpy (name, prefix, lenp - 1); + memcpy (name + lenp - 1, p, len + 1); + if (m) + { + name[lenp + len - 1] = '~'; + memcpy (name + lenp + len, m, lenm); + } + return get_identifier (name); +} + +tree +cxx_omp_mapper_lookup (tree id, tree type) +{ + if (TREE_CODE (type) != RECORD_TYPE + && TREE_CODE (type) != UNION_TYPE) + return NULL_TREE; + id = omp_mapper_id (id, type); + return lookup_name (id); +} + +tree +cxx_omp_extract_mapper_directive (tree vardecl) +{ + gcc_assert (TREE_CODE (vardecl) == VAR_DECL); + + /* Instantiate the decl if we haven't already. */ + mark_used (vardecl); + tree body = DECL_INITIAL (vardecl); + + if (TREE_CODE (body) == STATEMENT_LIST) + { + tree_stmt_iterator tsi = tsi_start (body); + gcc_assert (TREE_CODE (tsi_stmt (tsi)) == DECL_EXPR); + tsi_next (&tsi); + body = tsi_stmt (tsi); + } + + gcc_assert (TREE_CODE (body) == OMP_DECLARE_MAPPER); + + return body; +} + +/* For now we can handle singleton OMP_ARRAY_SECTIONs with custom mappers, but + nothing more complicated. */ + +tree +cxx_omp_map_array_section (location_t loc, tree t) +{ + tree low = TREE_OPERAND (t, 1); + tree len = TREE_OPERAND (t, 2); + + if (len && integer_onep (len)) + { + t = TREE_OPERAND (t, 0); + + if (!low) + low = integer_zero_node; + + if (TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE) + t = convert_from_reference (t); + + if (TYPE_PTR_P (TREE_TYPE (t))) + t = build_array_ref (loc, t, low); + else + t = error_mark_node; + } + + return t; +} + /* Helper function for cp_parser_omp_declare_reduction_exprs and tsubst_omp_udr. Remove CLEANUP_STMT for data (omp_priv variable). @@ -6558,6 +6654,29 @@ finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor) return false; } +/* Check an instance of an "omp declare mapper" function. */ + +bool +cp_check_omp_declare_mapper (tree udm) +{ + tree type = TREE_TYPE (udm); + location_t loc = DECL_SOURCE_LOCATION (udm); + + if (type == error_mark_node) + return false; + + if (!processing_template_decl + && TREE_CODE (type) != RECORD_TYPE + && TREE_CODE (type) != UNION_TYPE) + { + error_at (loc, "%qT is not a struct, union or class type in " + "%<#pragma omp declare mapper%>", type); + return false; + } + + return true; +} + /* Called from finish_struct_1. linear(this) or linear(this:step) clauses might not be finalized yet because the class has been incomplete when parsing #pragma omp declare simd methods. Fix those up now. */ @@ -8098,6 +8217,12 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) case OMP_CLAUSE_MAP: if (OMP_CLAUSE_MAP_IMPLICIT (c) && !implicit_moved) goto move_implicit; + if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POP_MAPPER_NAME) + { + remove = true; + break; + } /* FALLTHRU */ case OMP_CLAUSE_TO: case OMP_CLAUSE_FROM: @@ -9550,6 +9675,8 @@ struct omp_target_walk_data /* Local variables declared inside a BIND_EXPR, used to filter out such variables when recording lambda_objects_accessed. */ hash_set local_decls; + + omp_mapper_list *mappers; }; /* Helper function of finish_omp_target_clauses, called via @@ -9563,6 +9690,7 @@ finish_omp_target_clauses_r (tree *tp, int *walk_subtrees, void *ptr) struct omp_target_walk_data *data = (struct omp_target_walk_data *) ptr; tree current_object = data->current_object; tree current_closure = data->current_closure; + omp_mapper_list *mlist = data->mappers; /* References inside of these expression codes shouldn't incur any form of mapping, so return early. */ @@ -9576,6 +9704,27 @@ finish_omp_target_clauses_r (tree *tp, int *walk_subtrees, void *ptr) if (TREE_CODE (t) == OMP_CLAUSE) return NULL_TREE; + if (!processing_template_decl) + { + tree aggr_type = NULL_TREE; + + if (TREE_CODE (t) == COMPONENT_REF + && AGGREGATE_TYPE_P (TREE_TYPE (TREE_OPERAND (t, 0)))) + aggr_type = TREE_TYPE (TREE_OPERAND (t, 0)); + else if ((TREE_CODE (t) == VAR_DECL + || TREE_CODE (t) == PARM_DECL + || TREE_CODE (t) == RESULT_DECL) + && AGGREGATE_TYPE_P (TREE_TYPE (t))) + aggr_type = TREE_TYPE (t); + + if (aggr_type) + { + tree mapper_fn = cxx_omp_mapper_lookup (NULL_TREE, aggr_type); + if (mapper_fn) + mlist->add_mapper (NULL_TREE, aggr_type, mapper_fn); + } + } + if (current_object) { tree this_expr = TREE_OPERAND (current_object, 0); @@ -9678,10 +9827,48 @@ finish_omp_target_clauses (location_t loc, tree body, tree *clauses_ptr) else data.current_closure = NULL_TREE; - cp_walk_tree_without_duplicates (&body, finish_omp_target_clauses_r, &data); - auto_vec new_clauses; + if (!processing_template_decl) + { + hash_set > seen_types; + auto_vec mapper_fns; + omp_mapper_list mlist (&seen_types, &mapper_fns); + data.mappers = &mlist; + + cp_walk_tree_without_duplicates (&body, finish_omp_target_clauses_r, + &data); + + unsigned int i; + tree mapper_fn; + FOR_EACH_VEC_ELT (mapper_fns, i, mapper_fn) + c_omp_find_nested_mappers (&mlist, mapper_fn); + + FOR_EACH_VEC_ELT (mapper_fns, i, mapper_fn) + { + tree mapper = cxx_omp_extract_mapper_directive (mapper_fn); + if (mapper == error_mark_node) + continue; + tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper); + tree decl = OMP_DECLARE_MAPPER_DECL (mapper); + if (BASELINK_P (mapper_fn)) + mapper_fn = BASELINK_FUNCTIONS (mapper_fn); + + tree c = build_omp_clause (loc, OMP_CLAUSE__MAPPER_BINDING_); + OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name; + OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl; + OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapper_fn; + + new_clauses.safe_push (c); + } + } + else + { + data.mappers = NULL; + cp_walk_tree_without_duplicates (&body, finish_omp_target_clauses_r, + &data); + } + tree omp_target_this_expr = NULL_TREE; tree *explicit_this_deref_map = NULL; if (data.this_expr_accessed) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index e797402b59fc..b81804755f12 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -27,6 +27,9 @@ along with GCC; see the file COPYING3. If not see #include "match.h" #include "parse.h" #include "tree-core.h" +#include "tree.h" +#include "fold-const.h" +#include "tree-hash-traits.h" #include "omp-general.h" /* Current statement label. Zero means no statement label. Because new_st diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index ffc487a3a483..51bb64707f0b 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -219,6 +219,7 @@ struct gimplify_omp_ctx { struct gimplify_omp_ctx *outer_context; splay_tree variables; + hash_map, tree> *implicit_mappers; hash_set *privatized_types; tree clauses; /* Iteration variables in an OMP_FOR. */ @@ -452,6 +453,7 @@ new_omp_context (enum omp_region_type region_type) c = XCNEW (struct gimplify_omp_ctx); c->outer_context = gimplify_omp_ctxp; c->variables = splay_tree_new (splay_tree_compare_decl_uid, 0, 0); + c->implicit_mappers = new hash_map, tree>; c->privatized_types = new hash_set; c->location = input_location; c->region_type = region_type; @@ -475,6 +477,7 @@ delete_omp_context (struct gimplify_omp_ctx *c) { splay_tree_delete (c->variables); delete c->privatized_types; + delete c->implicit_mappers; c->loop_iter_var.release (); XDELETE (c); } @@ -11679,6 +11682,218 @@ error_out: return success; } +struct instantiate_mapper_info +{ + tree *mapper_clauses_p; + struct gimplify_omp_ctx *omp_ctx; + gimple_seq *pre_p; +}; + +/* Helper function for omp_instantiate_mapper. */ + +static tree +remap_mapper_decl_1 (tree *tp, int *walk_subtrees, void *data) +{ + copy_body_data *id = (copy_body_data *) data; + + if (DECL_P (*tp)) + { + tree replacement = remap_decl (*tp, id); + if (*tp != replacement) + { + *tp = unshare_expr (replacement); + *walk_subtrees = 0; + } + } + + return NULL_TREE; +} + +/* A copy_decl implementation (for use with tree-inline.cc functions) that + only transform decls or SSA names that are part of a map we already + prepared. */ + +static tree +omp_mapper_copy_decl (tree var, copy_body_data *cb) +{ + tree *repl = cb->decl_map->get (var); + + if (repl) + return *repl; + + return var; +} + +static tree * +omp_instantiate_mapper (gimple_seq *pre_p, + hash_map, tree> *implicit_mappers, + tree mapperfn, tree expr, enum gomp_map_kind outer_kind, + tree *mapper_clauses_p) +{ + tree mapper_name = NULL_TREE; + tree mapper = lang_hooks.decls.omp_extract_mapper_directive (mapperfn); + gcc_assert (TREE_CODE (mapper) == OMP_DECLARE_MAPPER); + + tree clause = OMP_DECLARE_MAPPER_CLAUSES (mapper); + tree dummy_var = OMP_DECLARE_MAPPER_DECL (mapper); + + /* The "extraction map" is used to map the mapper variable in the "declare + mapper" directive, and also any temporary variables that have been created + as part of expanding the mapper function's body (which are expanded as a + "bind" expression in the pre_p sequence). */ + hash_map extraction_map; + + extraction_map.put (dummy_var, expr); + extraction_map.put (expr, expr); + + /* This copy_body_data is only used to remap the decls in the + OMP_DECLARE_MAPPER tree node expansion itself. All relevant decls should + already be in the current function. */ + copy_body_data id; + memset (&id, 0, sizeof (id)); + id.src_fn = current_function_decl; + id.dst_fn = current_function_decl; + id.src_cfun = cfun; + id.decl_map = &extraction_map; + id.copy_decl = omp_mapper_copy_decl; + id.transform_call_graph_edges = CB_CGE_DUPLICATE; // ??? + id.transform_new_cfg = true; // ??? + + for (; clause; clause = OMP_CLAUSE_CHAIN (clause)) + { + enum gomp_map_kind map_kind = OMP_CLAUSE_MAP_KIND (clause); + tree *nested_mapper_p = NULL; + + if (map_kind == GOMP_MAP_PUSH_MAPPER_NAME) + { + mapper_name = OMP_CLAUSE_DECL (clause); + continue; + } + else if (map_kind == GOMP_MAP_POP_MAPPER_NAME) + { + mapper_name = NULL_TREE; + continue; + } + + tree decl = OMP_CLAUSE_DECL (clause); + tree unshared, type; + bool nonunit_array_with_mapper = false; + + if (TREE_CODE (decl) == OMP_ARRAY_SECTION) + { + location_t loc = OMP_CLAUSE_LOCATION (clause); + tree tmp = lang_hooks.decls.omp_map_array_section (loc, decl); + if (tmp == decl) + { + unshared = unshare_expr (clause); + nonunit_array_with_mapper = true; + type = TREE_TYPE (TREE_TYPE (decl)); + } + else + { + unshared = build_omp_clause (OMP_CLAUSE_LOCATION (clause), + OMP_CLAUSE_CODE (clause)); + OMP_CLAUSE_DECL (unshared) = tmp; + OMP_CLAUSE_SIZE (unshared) + = DECL_P (tmp) ? DECL_SIZE_UNIT (tmp) + : TYPE_SIZE_UNIT (TREE_TYPE (tmp)); + type = TREE_TYPE (tmp); + } + } + else + { + unshared = unshare_expr (clause); + type = TREE_TYPE (decl); + } + + walk_tree (&unshared, remap_mapper_decl_1, &id, NULL); + + if (OMP_CLAUSE_MAP_KIND (unshared) == GOMP_MAP_UNSET) + OMP_CLAUSE_SET_MAP_KIND (unshared, outer_kind); + + decl = OMP_CLAUSE_DECL (unshared); + type = TYPE_MAIN_VARIANT (type); + + nested_mapper_p = implicit_mappers->get ({ mapper_name, type }); + + if (nested_mapper_p && *nested_mapper_p != mapperfn) + { + if (nonunit_array_with_mapper) + { + sorry ("user-defined mapper with non-unit length array section"); + continue; + } + + if (map_kind == GOMP_MAP_UNSET) + map_kind = outer_kind; + + mapper_clauses_p + = omp_instantiate_mapper (pre_p, implicit_mappers, + *nested_mapper_p, decl, map_kind, + mapper_clauses_p); + continue; + } + + *mapper_clauses_p = unshared; + mapper_clauses_p = &OMP_CLAUSE_CHAIN (unshared); + } + + return mapper_clauses_p; +} + +static int +omp_instantiate_implicit_mappers (splay_tree_node n, void *data) +{ + tree decl = (tree) n->key; + instantiate_mapper_info *im_info = (instantiate_mapper_info *) data; + gimplify_omp_ctx *ctx = im_info->omp_ctx; + tree *mapper_p = NULL; + tree type = TREE_TYPE (decl); + bool ref_p = false; + unsigned flags = n->value; + + if (flags & (GOVD_EXPLICIT | GOVD_LOCAL)) + return 0; + if ((flags & GOVD_SEEN) == 0) + return 0; + /* If we already have clauses pertaining to a struct variable, then we don't + want to implicitly invoke a user-defined mapper. */ + if ((flags & GOVD_EXPLICIT) != 0 && AGGREGATE_TYPE_P (TREE_TYPE (decl))) + return 0; + + if (TREE_CODE (type) == REFERENCE_TYPE) + { + ref_p = true; + type = TREE_TYPE (type); + } + + type = TYPE_MAIN_VARIANT (type); + + if (DECL_P (decl) && type && AGGREGATE_TYPE_P (type)) + { + gcc_assert (ctx); + mapper_p = ctx->implicit_mappers->get ({ NULL_TREE, type }); + } + + if (mapper_p) + { + /* If we have a reference, map the pointed-to object rather than the + reference itself. */ + if (ref_p) + decl = build_fold_indirect_ref (decl); + + im_info->mapper_clauses_p + = omp_instantiate_mapper (im_info->pre_p, ctx->implicit_mappers, + *mapper_p, decl, GOMP_MAP_TOFROM, + im_info->mapper_clauses_p); + /* Make sure we don't map the same variable implicitly in + gimplify_adjust_omp_clauses_1 also. */ + n->value |= GOVD_EXPLICIT; + } + + return 0; +} + /* Scan the OMP clauses in *LIST_P, installing mappings into a new and previous omp contexts. */ @@ -12390,6 +12605,17 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, } goto do_notice; + case OMP_CLAUSE__MAPPER_BINDING_: + { + tree name = OMP_CLAUSE__MAPPER_BINDING__ID (c); + tree var = OMP_CLAUSE__MAPPER_BINDING__DECL (c); + tree type = TYPE_MAIN_VARIANT (TREE_TYPE (var)); + tree fndecl = OMP_CLAUSE__MAPPER_BINDING__MAPPER (c); + ctx->implicit_mappers->put ({ name, type }, fndecl); + remove = true; + break; + } + case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_ADDR: flags = GOVD_EXPLICIT; @@ -13421,6 +13647,30 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p, || code == OMP_TARGET_ENTER_DATA || code == OMP_TARGET_EXIT_DATA) { + tree mapper_clauses = NULL_TREE; + instantiate_mapper_info im_info; + + im_info.mapper_clauses_p = &mapper_clauses; + im_info.omp_ctx = ctx; + im_info.pre_p = pre_p; + + splay_tree_foreach (ctx->variables, + omp_instantiate_implicit_mappers, + (void *) &im_info); + + if (mapper_clauses) + { + mapper_clauses + = lang_hooks.decls.omp_finish_mapper_clauses (mapper_clauses); + + /* Stick the implicitly-expanded mapper clauses at the end of the + clause list. */ + tree *tail = list_p; + while (*tail) + tail = &OMP_CLAUSE_CHAIN (*tail); + *tail = mapper_clauses; + } + vec *groups; groups = omp_gather_mapping_groups (list_p); hash_map *grpmap = NULL; @@ -17200,6 +17450,15 @@ gimplify_omp_ordered (tree expr, gimple_seq body) return gimple_build_omp_ordered (body, OMP_ORDERED_CLAUSES (expr)); } +/* Gimplify an OMP_DECLARE_MAPPER node (by just removing it). */ + +static enum gimplify_status +gimplify_omp_declare_mapper (tree *expr_p) +{ + *expr_p = NULL_TREE; + return GS_ALL_DONE; +} + /* Convert the GENERIC expression tree *EXPR_P to GIMPLE. If the expression produces a value to be used as an operand inside a GIMPLE statement, the value will be stored back in *EXPR_P. This value will @@ -18122,6 +18381,10 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p, ret = gimplify_omp_atomic (expr_p, pre_p); break; + case OMP_DECLARE_MAPPER: + ret = gimplify_omp_declare_mapper (expr_p); + break; + case TRANSACTION_EXPR: ret = gimplify_transaction (expr_p, pre_p); break; diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index c6d18526360c..27a8916eb7fa 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -85,6 +85,10 @@ extern enum omp_clause_defaultmap_kind lhd_omp_predetermined_mapping (tree); extern tree lhd_omp_assignment (tree, tree, tree); extern void lhd_omp_finish_clause (tree, gimple_seq *, bool); extern tree lhd_omp_array_size (tree, gimple_seq *); +extern tree lhd_omp_finish_mapper_clauses (tree); +extern tree lhd_omp_mapper_lookup (tree, tree); +extern tree lhd_omp_extract_mapper_directive (tree); +extern tree lhd_omp_map_array_section (location_t, tree); struct gimplify_omp_ctx; extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); @@ -273,6 +277,11 @@ extern tree lhd_unit_size_without_reusable_padding (tree); #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR NULL #define LANG_HOOKS_OMP_CLAUSE_DTOR hook_tree_tree_tree_null #define LANG_HOOKS_OMP_FINISH_CLAUSE lhd_omp_finish_clause +#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES lhd_omp_finish_mapper_clauses +#define LANG_HOOKS_OMP_MAPPER_LOOKUP lhd_omp_mapper_lookup +#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \ + lhd_omp_extract_mapper_directive +#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION lhd_omp_map_array_section #define LANG_HOOKS_OMP_ALLOCATABLE_P hook_bool_tree_false #define LANG_HOOKS_OMP_SCALAR_P lhd_omp_scalar_p #define LANG_HOOKS_OMP_SCALAR_TARGET_P hook_bool_tree_false @@ -307,6 +316,10 @@ extern tree lhd_unit_size_without_reusable_padding (tree); LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR, \ LANG_HOOKS_OMP_CLAUSE_DTOR, \ LANG_HOOKS_OMP_FINISH_CLAUSE, \ + LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES, \ + LANG_HOOKS_OMP_MAPPER_LOOKUP, \ + LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE, \ + LANG_HOOKS_OMP_MAP_ARRAY_SECTION, \ LANG_HOOKS_OMP_ALLOCATABLE_P, \ LANG_HOOKS_OMP_SCALAR_P, \ LANG_HOOKS_OMP_SCALAR_TARGET_P, \ diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc index 9a1a9eccca96..6b32bb8e0c92 100644 --- a/gcc/langhooks.cc +++ b/gcc/langhooks.cc @@ -642,6 +642,41 @@ lhd_omp_array_size (tree, gimple_seq *) return NULL_TREE; } +/* Finalize clause list C after expanding custom mappers for implicitly-mapped + variables. */ + +tree +lhd_omp_finish_mapper_clauses (tree c) +{ + return c; +} + +/* Look up an OpenMP "declare mapper" mapper. */ + +tree +lhd_omp_mapper_lookup (tree, tree) +{ + return NULL_TREE; +} + +/* Given the representation used by the front-end to contain a mapper + directive, return the statement for the directive itself. */ + +tree +lhd_omp_extract_mapper_directive (tree) +{ + return error_mark_node; +} + +/* Return a simplified form for OMP_ARRAY_SECTION argument, or + error_mark_node if impossible. */ + +tree +lhd_omp_map_array_section (location_t, tree) +{ + return error_mark_node; +} + /* Return true if DECL is a scalar variable (for the purpose of implicit firstprivatization & mapping). Only if alloc_ptr_ok are allocatables and pointers accepted. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index cca75285fc2e..ca613a9d224c 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -313,6 +313,22 @@ struct lang_hooks_for_decls /* Do language specific checking on an implicitly determined clause. */ void (*omp_finish_clause) (tree clause, gimple_seq *pre_p, bool); + /* Finish language-specific processing on mapping nodes after expanding + user-defined mappers. */ + tree (*omp_finish_mapper_clauses) (tree clauses); + + /* Find a mapper in the current parsing context, given a NAME (or + NULL_TREE) and TYPE. */ + tree (*omp_mapper_lookup) (tree name, tree type); + + /* Return the statement for the mapper directive definition, from the + representation used to contain it (e.g. an inline function + declaration). */ + tree (*omp_extract_mapper_directive) (tree fndecl); + + /* Return a simplified form for OMP_ARRAY_SECTION argument. */ + tree (*omp_map_array_section) (location_t, tree t); + /* Return true if DECL is an allocatable variable (for the purpose of implicit mapping). */ bool (*omp_allocatable_p) (tree decl); diff --git a/gcc/omp-general.h b/gcc/omp-general.h index 5c7fa3a4aafb..a993b1294157 100644 --- a/gcc/omp-general.h +++ b/gcc/omp-general.h @@ -152,6 +152,92 @@ get_openacc_privatization_dump_flags () extern tree omp_build_component_ref (tree obj, tree field); +template +struct omp_name_type +{ + tree name; + T type; +}; + +template <> +struct default_hash_traits > + : typed_noop_remove > +{ + GTY((skip)) typedef omp_name_type value_type; + GTY((skip)) typedef omp_name_type compare_type; + + static hashval_t + hash (omp_name_type p) + { + return p.name ? iterative_hash_expr (p.name, TYPE_UID (p.type)) + : TYPE_UID (p.type); + } + + static const bool empty_zero_p = true; + + static bool + is_empty (omp_name_type p) + { + return p.type == NULL; + } + + static bool + is_deleted (omp_name_type) + { + return false; + } + + static bool + equal (const omp_name_type &a, const omp_name_type &b) + { + if (a.name == NULL_TREE && b.name == NULL_TREE) + return a.type == b.type; + else if (a.name == NULL_TREE || b.name == NULL_TREE) + return false; + else + return a.name == b.name && a.type == b.type; + } + + static void + mark_empty (omp_name_type &e) + { + e.type = NULL; + } +}; + +template +struct omp_mapper_list +{ + hash_set> *seen_types; + vec *mappers; + + omp_mapper_list (hash_set> *s, vec *m) + : seen_types (s), mappers (m) { } + + void add_mapper (tree name, T type, tree mapperfn) + { + /* We can't hash a NULL_TREE... */ + if (!name) + name = void_node; + + omp_name_type n_t = { name, type }; + + if (seen_types->contains (n_t)) + return; + + seen_types->add (n_t); + mappers->safe_push (mapperfn); + } + + bool contains (tree name, T type) + { + if (!name) + name = void_node; + + return seen_types->contains ({ name, type }); + } +}; + namespace omp_addr_tokenizer { /* These are the ways of accessing a variable that have special-case handling diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c new file mode 100644 index 000000000000..c4d017036c5e --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c @@ -0,0 +1,22 @@ +/* { dg-do compile { target c++ } } */ + +struct XYZ { + int a; + int *b; + int c; +}; + +#pragma omp declare mapper(struct XYZ t) +/* { dg-error "missing 'map' clause" "" { target c } .-1 } */ +/* { dg-error "missing 'map' clause before end of line" "" { target c++ } .-2 } */ + +struct ABC { + int *a; + int b; + int c; +}; + +#pragma omp declare mapper(struct ABC d) firstprivate(d.b) +/* { dg-error "unexpected clause" "" { target c } .-1 } */ +/* { dg-error "expected end of line before '\\(' token" "" { target c } .-2 } */ +/* { dg-error "unexpected clause before '\\(' token" "" { target c++ } .-3 } */ diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c new file mode 100644 index 000000000000..0db83b6fd335 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c @@ -0,0 +1,59 @@ +/* { dg-do compile { target c++ } } */ +/* { dg-options "-fopenmp -fdump-tree-gimple" } */ + +typedef struct { + int a, b, c, d; +} S; + +int main () +{ + S s; + #pragma omp declare mapper (S x) map(alloc: x.a) map(to: x.b) \ + map(from: x.c) map(tofrom: x.d) + + #pragma omp target enter data map(to: s) + + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(to:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(to:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + #pragma omp target exit data map(from: s) + + /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: 4\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(from:s\.c \[len: [0-9]+\]\) map\(from:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + + #pragma omp target enter data map(alloc: s) + + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(alloc:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(alloc:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + #pragma omp target exit data map(release: s) + + /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(release:s\.c \[len: [0-9]+\]\) map\(release:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + + #pragma omp target enter data map(present, to: s) + + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(force_present:s\.a \[len: [0-9]+\]\) map\(force_present:s\.b \[len: [0-9]+\]\) map\(force_present:s\.c \[len: [0-9]+\]\) map\(force_present:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + #pragma omp target exit data map(present, from: s) + + /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(force_present:s\.c \[len: [0-9]+\]\) map\(force_present:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + + #pragma omp target enter data map(always, to: s) + + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(always,to:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(always,to:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + #pragma omp target exit data map(always, from: s) + + /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(always,from:s\.c \[len: [0-9]+\]\) map\(always,from:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + + #pragma omp target enter data map(always, present, to: s) + + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(force_present:s\.a \[len: [0-9]+\]\) map\(always,present,to:s\.b \[len: [0-9]+\]\) map\(force_present:s\.c \[len: [0-9]+\]\) map\(always,present,to:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + #pragma omp target exit data map(always, present, from: s) + + /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(always,present,from:s\.c \[len: [0-9]+\]\) map\(always,present,from:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c new file mode 100644 index 000000000000..f8711f60a39a --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c @@ -0,0 +1,39 @@ +/* { dg-do compile { target c++ } } */ +/* { dg-options "-fopenmp -fdump-tree-gimple" } */ + +typedef struct { + int a, b, c, d; +} S; + +int main () +{ + S s = { 0, 0, 0, 0 }; + #pragma omp declare mapper (S x) map(alloc: x.a) map(to: x.b) \ + map(from: x.c) map(tofrom: x.d) + + #pragma omp target data map(s) + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(to:s\.b \[len: [0-9]+\]\) map\(from:s\.c \[len: [0-9]+\]\) map\(tofrom:s\.d \[len: [0-9]+\]\)} 3 "gimple" } } */ + { + #pragma omp target + { + s.a++; + s.b++; + s.c++; + s.d++; + } + } + + #pragma omp target data map(alloc: s) + /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(alloc:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(alloc:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */ + { + #pragma omp target + { + s.a++; + s.b++; + s.c++; + s.d++; + } + } + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c new file mode 100644 index 000000000000..983d979d68c5 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c @@ -0,0 +1,30 @@ +// { dg-do compile { target c++ } } +// { dg-additional-options "-fdump-tree-gimple" } + +#include + +// Test named mapper invocation. + +struct S { + int *ptr; + int size; +}; + +int main (int argc, char *argv[]) +{ + int N = 1024; +#pragma omp declare mapper (mapN:struct S s) map(to:s.ptr, s.size) \ + map(s.ptr[:N]) + + struct S s; + s.ptr = (int *) malloc (sizeof (int) * N); + +#pragma omp target map(mapper(mapN), tofrom: s) +// { dg-final { scan-tree-dump {map\(struct:s \[len: 2\]\) map\(alloc:s\.ptr \[len: [0-9]+\]\) map\(to:s\.size \[len: [0-9]+\]\) map\(tofrom:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} "gimple" } } + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c new file mode 100644 index 000000000000..6d933e4bf6f4 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c @@ -0,0 +1,78 @@ +/* { dg-do compile { target c++ } } */ +/* { dg-additional-options "-fdump-tree-original" } */ + +/* Check mapper binding clauses. */ + +struct Y { + int z; +}; + +struct Z { + int z; +}; + +#pragma omp declare mapper (struct Y y) map(tofrom: y) +#pragma omp declare mapper (struct Z z) map(tofrom: z) + +int foo (void) +{ + struct Y yy; + struct Z zz; + int dummy; + +#pragma omp target data map(dummy) + { + #pragma omp target + { + yy.z++; + zz.z++; + } + yy.z++; + } + return yy.z; +} + +struct P +{ + struct Z *zp; +}; + +int bar (void) +{ + struct Y yy; + struct Z zz; + struct P pp; + struct Z t; + int dummy; + + pp.zp = &t; + +#pragma omp declare mapper (struct Y y) map(tofrom: y.z) +#pragma omp declare mapper (struct Z z) map(tofrom: z.z) + +#pragma omp target data map(dummy) + { + #pragma omp target + { + yy.z++; + zz.z++; + } + yy.z++; + } + + #pragma omp declare mapper(struct P x) map(to:x.zp) map(tofrom:*x.zp) + + #pragma omp target + { + zz = *pp.zp; + } + + return zz.z; +} + +/* { dg-final { scan-tree-dump-times {mapper_binding\(struct Y,omp declare mapper ~1Y\) mapper_binding\(struct Z,omp declare mapper ~1Z\)} 2 "original" { target c++ } } } */ +/* { dg-final { scan-tree-dump {mapper_binding\(struct Z,omp declare mapper ~1Z\) mapper_binding\(struct P,omp declare mapper ~1P\)} "original" { target c++ } } } */ + +/* { dg-final { scan-tree-dump {mapper_binding\(struct Z,#pragma omp declare mapper \(struct Z z\) map\(tofrom:z\)\) mapper_binding\(struct Y,#pragma omp declare mapper \(struct Y y\) map\(tofrom:y\)\)} "original" { target c } } } */ +/* { dg-final { scan-tree-dump {mapper_binding\(struct Z,#pragma omp declare mapper \(struct Z z\) map\(tofrom:z\.z\)\) mapper_binding\(struct Y,#pragma omp declare mapper \(struct Y y\) map\(tofrom:y\.z\)\)} "original" { target c } } } */ +/* { dg-final { scan-tree-dump {mapper_binding\(struct P,#pragma omp declare mapper \(struct P x\) map\(tofrom:\(x\.zp\)\[0:1\]\) map\(to:x.zp\)\) mapper_binding\(struct Z,#pragma omp declare mapper \(struct Z z\) map\(tofrom:z\.z\)\)} "original" { target c } } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c new file mode 100644 index 000000000000..f675a8c68902 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c @@ -0,0 +1,26 @@ +/* { dg-do compile { target c++ } } */ + +typedef struct S_ { + int *myarr; + int size; +} S; + +#pragma omp declare mapper (named: struct S_ v) map(to:v.size, v.myarr) \ + map(tofrom: v.myarr[0:v.size]) +/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-2 } */ +/* { dg-note "'#pragma omp declare mapper \\(named: S_\\)' previously defined here" "" { target c++ } .-3 } */ + +#pragma omp declare mapper (named: S v) map(to:v.size, v.myarr) \ + map(tofrom: v.myarr[0:v.size]) +/* { dg-error "redeclaration of 'named' '#pragma omp declare mapper' for type 'S' \\\{aka 'struct S_'\\\}" "" { target c } .-2 } */ +/* { dg-error "redefinition of '#pragma omp declare mapper \\(named: S\\)'" "" { target c++ } .-3 } */ + +#pragma omp declare mapper (struct S_ v) map(to:v.size, v.myarr) \ + map(tofrom: v.myarr[0:v.size]) +/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-2 } */ +/* { dg-note "'#pragma omp declare mapper \\(S_\\)' previously defined here" "" { target c++ } .-3 } */ + +#pragma omp declare mapper (S v) map(to:v.size, v.myarr) \ + map(tofrom: v.myarr[0:v.size]) +/* { dg-error "redeclaration of '' '#pragma omp declare mapper' for type 'S' \\\{aka 'struct S_'\\\}" "" { target c } .-2 } */ +/* { dg-error "redefinition of '#pragma omp declare mapper \\(S\\)'" "" { target c++ } .-3 } */ diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c new file mode 100644 index 000000000000..a2f6c08cdfdd --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c @@ -0,0 +1,23 @@ +/* { dg-do compile { target c++ } } */ + +int x = 5; + +struct Q { + int *arr1; + int *arr2; + int *arr3; +}; + +#pragma omp declare mapper (struct Q myq) map(myq.arr2[0:x]) + +struct R { + int *arr1; + int *arr2; + int *arr3; +}; + +#pragma omp declare mapper (struct R myr) map(myr.arr3[0:y]) +/* { dg-error "'y' undeclared" "" { target c } .-1 } */ +/* { dg-error "'y' was not declared in this scope" "" { target c++ } .-2 } */ + +int y = 7; diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c new file mode 100644 index 000000000000..1b1be9dbb666 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c @@ -0,0 +1,29 @@ +/* { dg-do compile { target c++ } } */ + +struct Q { + int *arr1; + int *arr2; + int *arr3; +}; + +int foo (void) +{ + int x = 5; + #pragma omp declare mapper (struct Q myq) map(myq.arr2[0:x]) + return x; +} + +struct R { + int *arr1; + int *arr2; + int *arr3; +}; + +int bar (void) +{ + #pragma omp declare mapper (struct R myr) map(myr.arr3[0:y]) + /* { dg-error "'y' undeclared" "" { target c } .-1 } */ + /* { dg-error "'y' was not declared in this scope" "" { target c++ } .-2 } */ + int y = 7; + return y; +} diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c new file mode 100644 index 000000000000..86ddb942072c --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c @@ -0,0 +1,43 @@ +/* { dg-do compile { target c++ } } */ + +struct Q { + int *arr1; + int *arr2; + int *arr3; + int len; +}; + +struct R { + struct Q qarr[5]; +}; + +struct R2 { + struct Q *qptr; +}; + +#pragma omp declare mapper (struct Q myq) map(myq.arr1[0:myq.len]) \ + map(myq.arr2[0:myq.len]) \ + map(myq.arr3[0:myq.len]) + +#pragma omp declare mapper (struct R myr) map(myr.qarr[2:3]) + +#pragma omp declare mapper (struct R2 myr2) map(myr2.qptr[2:3]) + +int main (int argc, char *argv[]) +{ + struct R r; + struct R2 r2; + int N = 256; + +#pragma omp target +/* { dg-message "sorry, unimplemented: user-defined mapper with non-unit length array section" "" { target *-*-* } .-1 } */ + { + for (int i = 2; i < 5; i++) + for (int j = 0; j < N; j++) + { + r.qarr[i].arr1[j]++; + r2.qptr[i].arr2[j]++; + } + } +} + diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c new file mode 100644 index 000000000000..54e58426910e --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c @@ -0,0 +1,34 @@ +/* { dg-do compile { target c++ } } */ + +int x = 5; + +struct Q { + int *arr1; + int *arr2; + int *arr3; +}; + +int y = 5; + +#pragma omp declare mapper (struct Q myq) map(myq.arr2[0:x]) +/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-1 } */ +/* { dg-note "'#pragma omp declare mapper \\(Q\\)' previously defined here" "" { target c++ } .-2 } */ + +#pragma omp declare mapper (struct Q myq) map(myq.arr2[0:y]) +/* { dg-error "redeclaration of '' '#pragma omp declare mapper' for type 'struct Q'" "" { target c } .-1 } */ +/* { dg-error "redefinition of '#pragma omp declare mapper \\(Q\\)'" "" { target c++ } .-2 } */ + +struct R { + int *arr1; +}; + +void foo (void) +{ +#pragma omp declare mapper (struct R myr) map(myr.arr1[0:x]) +/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-1 } */ +/* { dg-note "'#pragma omp declare mapper \\(R\\)' previously declared here" "" { target c++ } .-2 } */ + +#pragma omp declare mapper (struct R myr) map(myr.arr1[0:y]) +/* { dg-error "redeclaration of '' '#pragma omp declare mapper' for type 'struct R'" "" { target c } .-1 } */ +/* { dg-error "redeclaration of '#pragma omp declare mapper \\(R\\)'" "" { target c++ } .-2 } */ +} diff --git a/gcc/testsuite/c-c++-common/gomp/map-6.c b/gcc/testsuite/c-c++-common/gomp/map-6.c index 014ed35ab415..789088396e86 100644 --- a/gcc/testsuite/c-c++-common/gomp/map-6.c +++ b/gcc/testsuite/c-c++-common/gomp/map-6.c @@ -13,19 +13,19 @@ foo (void) #pragma omp target map (to:a) ; - #pragma omp target map (a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */ + #pragma omp target map (a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'mapper' or 'present'" } */ ; - #pragma omp target map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */ + #pragma omp target map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'mapper' or 'present'" } */ ; - #pragma omp target enter data map(b7) map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */ + #pragma omp target enter data map(b7) map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'mapper' or 'present'" } */ ; - #pragma omp target exit data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */ + #pragma omp target exit data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'mapper' or 'present'" } */ ; - #pragma omp target data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */ + #pragma omp target data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'mapper' or 'present'" } */ ; diff --git a/gcc/testsuite/g++.dg/gomp/declare-mapper-1.C b/gcc/testsuite/g++.dg/gomp/declare-mapper-1.C new file mode 100644 index 000000000000..8af3bac10718 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/declare-mapper-1.C @@ -0,0 +1,58 @@ +// { dg-do compile } +// { dg-additional-options "-fdump-tree-gimple" } + +// "omp declare mapper" support -- check expansion in gimple. + +struct S { + int *ptr; + int size; +}; + +#define N 64 + +#pragma omp declare mapper (S w) map(w.size, w.ptr, w.ptr[:w.size]) +#pragma omp declare mapper (foo:S w) map(to:w.size, w.ptr) map(w.ptr[:w.size]) + +int main (int argc, char *argv[]) +{ + S s; + s.ptr = new int[N]; + s.size = N; + +#pragma omp declare mapper (bar:S w) map(w.size, w.ptr, w.ptr[:w.size]) + +#pragma omp target + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(tofrom: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(mapper(default), tofrom: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(mapper(foo), alloc: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(mapper(bar), tofrom: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + + return 0; +} + +// { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(alloc:s\.ptr \[len: [0-9]+\]\) map\(tofrom:s\.size \[len: [0-9]+\]\) map\(tofrom:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 4 "gimple" } } +// { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(alloc:s\.ptr \[len: [0-9]+\]\) map\(alloc:s\.size \[len: [0-9]+\]\) map\(alloc:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 1 "gimple" } } diff --git a/gcc/testsuite/g++.dg/gomp/declare-mapper-2.C b/gcc/testsuite/g++.dg/gomp/declare-mapper-2.C new file mode 100644 index 000000000000..7df72c76e2af --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/declare-mapper-2.C @@ -0,0 +1,30 @@ +// { dg-do compile } + +// Error-checking tests for "omp declare mapper". + +struct S { + int *ptr; + int size; +}; + +struct Z { + int z; +}; + +int main (int argc, char *argv[]) +{ +#pragma omp declare mapper (S v) map(v.size, v.ptr[:v.size]) // { dg-note "'#pragma omp declare mapper \\(S\\)' previously declared here" } + + /* This one's a duplicate. */ +#pragma omp declare mapper (default: S v) map (to: v.size) map (v) // { dg-error "redeclaration of '#pragma omp declare mapper \\(S\\)'" } + + /* ...and this one doesn't use a "base language identifier" for the mapper + name. */ +#pragma omp declare mapper (case: S v) map (to: v.size) // { dg-error "expected identifier or 'default' before 'case'" } + // { dg-error "expected ':' before 'case'" "" { target *-*-* } .-1 } + + /* A non-struct/class/union type isn't supposed to work. */ +#pragma omp declare mapper (name:Z [5]foo) map (foo[0].z) // { dg-error "'Z \\\[5\\\]' is not a struct, union or class type in '#pragma omp declare mapper'" } + + return 0; +} diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 668808a29d07..41c6560babf5 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -347,6 +347,10 @@ enum omp_clause_code { /* OpenMP clause: doacross ({source,sink}:vec). */ OMP_CLAUSE_DOACROSS, + /* OpenMP mapper binding: record implicit mappers in scope for aggregate + types used within an offload region. */ + OMP_CLAUSE__MAPPER_BINDING_, + /* Internal structure to hold OpenACC cache directive's variable-list. #pragma acc cache (variable-list). */ OMP_CLAUSE__CACHE_, diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index b6c029c346ef..51aca38638af 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -1015,6 +1015,15 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case GOMP_MAP_ALWAYS_PRESENT_TOFROM: pp_string (pp, "always,present,tofrom"); break; + case GOMP_MAP_UNSET: + pp_string (pp, "unset"); + break; + case GOMP_MAP_PUSH_MAPPER_NAME: + pp_string (pp, "push_mapper"); + break; + case GOMP_MAP_POP_MAPPER_NAME: + pp_string (pp, "pop_mapper"); + break; default: gcc_unreachable (); } @@ -1082,6 +1091,23 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) spc, flags, false); goto print_clause_size; + case OMP_CLAUSE__MAPPER_BINDING_: + pp_string (pp, "mapper_binding("); + if (OMP_CLAUSE__MAPPER_BINDING__ID (clause)) + { + dump_generic_node (pp, OMP_CLAUSE__MAPPER_BINDING__ID (clause), spc, + flags, false); + pp_comma (pp); + } + dump_generic_node (pp, + TREE_TYPE (OMP_CLAUSE__MAPPER_BINDING__DECL (clause)), + spc, flags, false); + pp_comma (pp); + dump_generic_node (pp, OMP_CLAUSE__MAPPER_BINDING__MAPPER (clause), spc, + flags, false); + pp_right_paren (pp); + break; + case OMP_CLAUSE_NUM_TEAMS: pp_string (pp, "num_teams("); if (OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (clause)) @@ -3851,6 +3877,21 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, is_expr = false; break; + case OMP_DECLARE_MAPPER: + pp_string (pp, "#pragma omp declare mapper ("); + if (OMP_DECLARE_MAPPER_ID (node)) + { + dump_generic_node (pp, OMP_DECLARE_MAPPER_ID (node), spc, flags, + false); + pp_colon (pp); + } + dump_generic_node (pp, TREE_TYPE (node), spc, flags, false); + pp_space (pp); + dump_generic_node (pp, OMP_DECLARE_MAPPER_DECL (node), spc, flags, false); + pp_right_paren (pp); + dump_omp_clauses (pp, OMP_DECLARE_MAPPER_CLAUSES (node), spc, flags); + break; + case TRANSACTION_EXPR: if (TRANSACTION_EXPR_OUTER (node)) pp_string (pp, "__transaction_atomic [[outer]]"); diff --git a/gcc/tree.cc b/gcc/tree.cc index 420857b110c4..8929d4af9399 100644 --- a/gcc/tree.cc +++ b/gcc/tree.cc @@ -269,6 +269,7 @@ unsigned const char omp_clause_num_ops[] = 2, /* OMP_CLAUSE_MAP */ 1, /* OMP_CLAUSE_HAS_DEVICE_ADDR */ 1, /* OMP_CLAUSE_DOACROSS */ + 3, /* OMP_CLAUSE__MAPPER_BINDING_ */ 2, /* OMP_CLAUSE__CACHE_ */ 2, /* OMP_CLAUSE_GANG */ 1, /* OMP_CLAUSE_ASYNC */ @@ -360,6 +361,7 @@ const char * const omp_clause_code_name[] = "map", "has_device_addr", "doacross", + "_mapper_binding_", "_cache_", "gang", "async", diff --git a/gcc/tree.def b/gcc/tree.def index 5b6b1bab9db6..3eaf79193516 100644 --- a/gcc/tree.def +++ b/gcc/tree.def @@ -1291,6 +1291,13 @@ DEFTREECODE (OMP_SECTION, "omp_section", tcc_statement, 1) Operand 0: OMP_MASTER_BODY: Master section body. */ DEFTREECODE (OMP_MASTER, "omp_master", tcc_statement, 1) +/* OpenMP - #pragma omp declare mapper ([id:] type var) [clause1 ... clauseN] + Operand 0: Identifier. + Operand 1: Variable decl. + Operand 2: List of clauses. + The type of the construct is used for the type to be mapped. */ +DEFTREECODE (OMP_DECLARE_MAPPER, "omp_declare_mapper", tcc_statement, 3) + /* OpenACC - #pragma acc cache (variable1 ... variableN) Operand 0: OACC_CACHE_CLAUSES: List of variables (transformed into OMP_CLAUSE__CACHE_ clauses). */ diff --git a/gcc/tree.h b/gcc/tree.h index 088e39da532a..7b0fd62aab24 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1572,6 +1572,13 @@ class auto_suppress_location_wrappers #define OMP_TARGET_EXIT_DATA_CLAUSES(NODE)\ TREE_OPERAND (OMP_TARGET_EXIT_DATA_CHECK (NODE), 0) +#define OMP_DECLARE_MAPPER_ID(NODE) \ + TREE_OPERAND (OMP_DECLARE_MAPPER_CHECK (NODE), 0) +#define OMP_DECLARE_MAPPER_DECL(NODE) \ + TREE_OPERAND (OMP_DECLARE_MAPPER_CHECK (NODE), 1) +#define OMP_DECLARE_MAPPER_CLAUSES(NODE) \ + TREE_OPERAND (OMP_DECLARE_MAPPER_CHECK (NODE), 2) + #define OMP_SCAN_BODY(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 0) #define OMP_SCAN_CLAUSES(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 1) @@ -2019,6 +2026,18 @@ class auto_suppress_location_wrappers #define OMP_CLAUSE__SCANTEMP__CONTROL(NODE) \ TREE_PRIVATE (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE__SCANTEMP_)) +#define OMP_CLAUSE__MAPPER_BINDING__ID(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, \ + OMP_CLAUSE__MAPPER_BINDING_), 0) + +#define OMP_CLAUSE__MAPPER_BINDING__DECL(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, \ + OMP_CLAUSE__MAPPER_BINDING_), 1) + +#define OMP_CLAUSE__MAPPER_BINDING__MAPPER(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, \ + OMP_CLAUSE__MAPPER_BINDING_), 2) + /* SSA_NAME accessors. */ /* Whether SSA_NAME NODE is a virtual operand. This simply caches the diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 20c722665680..4d9ebdbe9f79 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -209,7 +209,13 @@ enum gomp_map_kind GOMP_MAP_PRESENT_ALLOC = (GOMP_MAP_LAST | 4), GOMP_MAP_PRESENT_TO = (GOMP_MAP_LAST | 5), GOMP_MAP_PRESENT_FROM = (GOMP_MAP_LAST | 6), - GOMP_MAP_PRESENT_TOFROM = (GOMP_MAP_LAST | 7) + GOMP_MAP_PRESENT_TOFROM = (GOMP_MAP_LAST | 7), + /* Unset, used for "declare mapper" maps with no explicit data movement + specified. These use the movement specified at the invocation site. */ + GOMP_MAP_UNSET = (GOMP_MAP_LAST | 8), + /* Used to record the name of a named mapper. */ + GOMP_MAP_PUSH_MAPPER_NAME = (GOMP_MAP_LAST | 9), + GOMP_MAP_POP_MAPPER_NAME = (GOMP_MAP_LAST | 10) }; #define GOMP_MAP_COPY_TO_P(X) \ diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-1.C b/libgomp/testsuite/libgomp.c++/declare-mapper-1.C new file mode 100644 index 000000000000..aba4f4265392 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-1.C @@ -0,0 +1,87 @@ +// { dg-do run } + +#include +#include + +#define N 64 + +struct points +{ + double *x; + double *y; + double *z; + size_t len; +}; + +#pragma omp declare mapper(points p) map(to:p.x, p.y, p.z) \ + map(p.x[0:p.len]) \ + map(p.y[0:p.len]) \ + map(p.z[0:p.len]) + +struct shape +{ + points tmp; + points *pts; + int metadata[128]; +}; + +#pragma omp declare mapper(shape s) map(tofrom:s.pts, *s.pts) map(alloc:s.tmp) + +void +alloc_points (points *pts, size_t sz) +{ + pts->x = new double[sz]; + pts->y = new double[sz]; + pts->z = new double[sz]; + pts->len = sz; + for (int i = 0; i < sz; i++) + pts->x[i] = pts->y[i] = pts->z[i] = 0; +} + +int main (int argc, char *argv[]) +{ + shape myshape; + points mypts; + + myshape.pts = &mypts; + + alloc_points (&myshape.tmp, N); + myshape.pts = new points; + alloc_points (myshape.pts, N); + + #pragma omp target map(myshape) + { + for (int i = 0; i < N; i++) + { + myshape.pts->x[i]++; + myshape.pts->y[i]++; + myshape.pts->z[i]++; + } + } + + for (int i = 0; i < N; i++) + { + assert (myshape.pts->x[i] == 1); + assert (myshape.pts->y[i] == 1); + assert (myshape.pts->z[i] == 1); + } + + #pragma omp target + { + for (int i = 0; i < N; i++) + { + myshape.pts->x[i]++; + myshape.pts->y[i]++; + myshape.pts->z[i]++; + } + } + + for (int i = 0; i < N; i++) + { + assert (myshape.pts->x[i] == 2); + assert (myshape.pts->y[i] == 2); + assert (myshape.pts->z[i] == 2); + } + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-2.C b/libgomp/testsuite/libgomp.c++/declare-mapper-2.C new file mode 100644 index 000000000000..d848fdb73692 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-2.C @@ -0,0 +1,55 @@ +// { dg-do run } + +#include + +#define N 256 + +struct doublebuf +{ + int buf_a[N][N]; + int buf_b[N][N]; +}; + +#pragma omp declare mapper(lo:doublebuf b) map(b.buf_a[0:N/2][0:N]) \ + map(b.buf_b[0:N/2][0:N]) + +#pragma omp declare mapper(hi:doublebuf b) map(b.buf_a[N/2:N/2][0:N]) \ + map(b.buf_b[N/2:N/2][0:N]) + +int main (int argc, char *argv[]) +{ + doublebuf db; + + for (int i = 0; i < N; i++) + for (int j = 0; j < N; j++) + db.buf_a[i][j] = db.buf_b[i][j] = 0; + + #pragma omp target map(mapper(lo), tofrom:db) + { + for (int i = 0; i < N / 2; i++) + for (int j = 0; j < N; j++) + { + db.buf_a[i][j]++; + db.buf_b[i][j]++; + } + } + + #pragma omp target map(mapper(hi), tofrom:db) + { + for (int i = N / 2; i < N; i++) + for (int j = 0; j < N; j++) + { + db.buf_a[i][j]++; + db.buf_b[i][j]++; + } + } + + for (int i = 0; i < N; i++) + for (int j = 0; j < N; j++) + { + assert (db.buf_a[i][j] == 1); + assert (db.buf_b[i][j] == 1); + } + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-3.C b/libgomp/testsuite/libgomp.c++/declare-mapper-3.C new file mode 100644 index 000000000000..ea9b7ded75b6 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-3.C @@ -0,0 +1,63 @@ +// { dg-do run } + +#include +#include + +struct S { + int *myarr; +}; + +#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:20]) + +namespace A { +#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:100]) +} + +namespace B { +#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[100:100]) +} + +namespace A +{ + void incr_a (S my_s) + { +#pragma omp target + { + for (int i = 0; i < 100; i++) + my_s.myarr[i]++; + } + } +} + +namespace B +{ + void incr_b (S my_s) + { +#pragma omp target + { + for (int i = 100; i < 200; i++) + my_s.myarr[i]++; + } + } +} + +int main (int argc, char *argv[]) +{ + S my_s; + + my_s.myarr = (int *) calloc (200, sizeof (int)); + +#pragma omp target + { + for (int i = 0; i < 20; i++) + my_s.myarr[i]++; + } + + A::incr_a (my_s); + B::incr_b (my_s); + + for (int i = 0; i < 200; i++) + assert (my_s.myarr[i] == (i < 20) ? 2 : 1); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-4.C b/libgomp/testsuite/libgomp.c++/declare-mapper-4.C new file mode 100644 index 000000000000..f194e63b5b7f --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-4.C @@ -0,0 +1,63 @@ +// { dg-do run } + +#include +#include + +struct S { + int *myarr; +}; + +#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:20]) + +namespace A { +#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:100]) +} + +namespace B { +#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[100:100]) +} + +namespace A +{ + void incr_a (S &my_s) + { +#pragma omp target + { + for (int i = 0; i < 100; i++) + my_s.myarr[i]++; + } + } +} + +namespace B +{ + void incr_b (S &my_s) + { +#pragma omp target + { + for (int i = 100; i < 200; i++) + my_s.myarr[i]++; + } + } +} + +int main (int argc, char *argv[]) +{ + S my_s; + + my_s.myarr = (int *) calloc (200, sizeof (int)); + +#pragma omp target + { + for (int i = 0; i < 20; i++) + my_s.myarr[i]++; + } + + A::incr_a (my_s); + B::incr_b (my_s); + + for (int i = 0; i < 200; i++) + assert (my_s.myarr[i] == (i < 20) ? 2 : 1); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-5.C b/libgomp/testsuite/libgomp.c++/declare-mapper-5.C new file mode 100644 index 000000000000..0030de8791a0 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-5.C @@ -0,0 +1,52 @@ +// { dg-do run } + +#include + +struct S +{ + int *myarr; + int len; +}; + +class C +{ + S smemb; +#pragma omp declare mapper (custom:S s) map(to:s.myarr) \ + map(tofrom:s.myarr[0:s.len]) + +public: + C(int l) + { + smemb.myarr = new int[l]; + smemb.len = l; + for (int i = 0; i < l; i++) + smemb.myarr[i] = 0; + } + void bump(); + void check(); +}; + +void +C::bump () +{ +#pragma omp target map(mapper(custom), tofrom: smemb) + { + for (int i = 0; i < smemb.len; i++) + smemb.myarr[i]++; + } +} + +void +C::check () +{ + for (int i = 0; i < smemb.len; i++) + assert (smemb.myarr[i] == 1); +} + +int main (int argc, char *argv[]) +{ + C test (100); + test.bump (); + test.check (); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-6.C b/libgomp/testsuite/libgomp.c++/declare-mapper-6.C new file mode 100644 index 000000000000..14ed10df7025 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-6.C @@ -0,0 +1,37 @@ +// { dg-do run } + +#include + +template +void adjust (T param) +{ +#pragma omp declare mapper (T x) map(to:x.len, x.base) \ + map(tofrom:x.base[0:x.len]) + +#pragma omp target + for (int i = 0; i < param.len; i++) + param.base[i]++; +} + +struct S { + int len; + int *base; +}; + +int main (int argc, char *argv[]) +{ + S a; + + a.len = 100; + a.base = new int[a.len]; + + for (int i = 0; i < a.len; i++) + a.base[i] = 0; + + adjust (a); + + for (int i = 0; i < a.len; i++) + assert (a.base[i] == 1); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-7.C b/libgomp/testsuite/libgomp.c++/declare-mapper-7.C new file mode 100644 index 000000000000..ab6320997148 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-7.C @@ -0,0 +1,48 @@ +// { dg-do run } + +#include + +struct S +{ + int *myarr; +}; + +struct T +{ + S *s; +}; + +#pragma omp declare mapper (s100: S x) map(to: x.myarr) \ + map(tofrom: x.myarr[0:100]) + +void +bump (T t) +{ + /* Here we have an implicit/default mapper invoking a named mapper. We + need to make sure that can be located properly at gimplification + time. */ +#pragma omp declare mapper (T t) map(to:t.s) map(mapper(s100), tofrom: t.s[0]) + +#pragma omp target + for (int i = 0; i < 100; i++) + t.s->myarr[i]++; +} + +int main (int argc, char *argv[]) +{ + S my_s; + T my_t; + + my_s.myarr = new int[100]; + my_t.s = &my_s; + + for (int i = 0; i < 100; i++) + my_s.myarr[i] = 0; + + bump (my_t); + + for (int i = 0; i < 100; i++) + assert (my_s.myarr[i] == 1); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-8.C b/libgomp/testsuite/libgomp.c++/declare-mapper-8.C new file mode 100644 index 000000000000..3818e5264d35 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/declare-mapper-8.C @@ -0,0 +1,61 @@ +// { dg-do run } + +#include + +struct S +{ + int *myarr; + int len; +}; + +template +class C +{ + T memb; +#pragma omp declare mapper (T t) map(to:t.len, t.myarr) \ + map(tofrom:t.myarr[0:t.len]) + +public: + C(int sz); + ~C(); + void bump(); + void check(); +}; + +template +C::C(int sz) +{ + memb.myarr = new int[sz]; + for (int i = 0; i < sz; i++) + memb.myarr[i] = 0; + memb.len = sz; +} + +template +C::~C() +{ + delete[] memb.myarr; +} + +template +void C::bump() +{ +#pragma omp target map(memb) + for (int i = 0; i < memb.len; i++) + memb.myarr[i]++; +} + +template +void C::check() +{ + for (int i = 0; i < memb.len; i++) + assert (memb.myarr[i] == 1); +} + +int main(int argc, char *argv[]) +{ + C c_int(100); + c_int.bump(); + c_int.check(); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c new file mode 100644 index 000000000000..b0fa40929fbc --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c @@ -0,0 +1,60 @@ +/* { dg-do run { target c++ } } */ + +#include +#include +#include + +#define N 64 + +typedef struct { + int *arr; + int size; +} B; + +#pragma omp declare mapper (mapB : B myb) map(to: myb.size, myb.arr) \ + map(tofrom: myb.arr[0:myb.size]) + +struct A { + int *arr1; + B *arr2; + int arr3[N]; +}; + +int +main (int argc, char *argv[]) +{ + struct A var; + + memset (&var, 0, sizeof var); + var.arr1 = (int *) calloc (N, sizeof (int)); + var.arr2 = (B *) malloc (sizeof (B)); + var.arr2->arr = (int *) calloc (N, sizeof (float)); + var.arr2->size = N; + + { + #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \ + map(tofrom: x.arr1[0:N]) \ + map(mapper(mapB), tofrom: x.arr2[0:1]) + #pragma omp target + { + for (int i = 0; i < N; i++) + { + var.arr1[i]++; + var.arr2->arr[i]++; + } + } + } + + for (int i = 0; i < N; i++) + { + assert (var.arr1[i] == 1); + assert (var.arr2->arr[i] == 1); + assert (var.arr3[i] == 0); + } + + free (var.arr1); + free (var.arr2->arr); + free (var.arr2); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c new file mode 100644 index 000000000000..b509ddc412c5 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c @@ -0,0 +1,59 @@ +/* { dg-do run { target c++ } } */ + +#include +#include +#include + +#define N 64 + +typedef struct B_tag { + int *arr; + int size; +} B; + +#pragma omp declare mapper (B myb) map(to: myb.size, myb.arr) \ + map(tofrom: myb.arr[0:myb.size]) + +struct A { + int *arr1; + B *arr2; + int arr3[N]; +}; + +int +main (int argc, char *argv[]) +{ + struct A var; + + memset (&var, 0, sizeof var); + var.arr1 = (int *) calloc (N, sizeof (int)); + var.arr2 = (B *) malloc (sizeof (B)); + var.arr2->arr = (int *) calloc (N, sizeof (int)); + var.arr2->size = N; + + { + #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \ + map(tofrom: x.arr1[0:N]) map(tofrom: x.arr2[0:1]) + #pragma omp target + { + for (int i = 0; i < N; i++) + { + var.arr1[i]++; + var.arr2->arr[i]++; + } + } + } + + for (int i = 0; i < N; i++) + { + assert (var.arr1[i] == 1); + assert (var.arr2->arr[i] == 1); + assert (var.arr3[i] == 0); + } + + free (var.arr1); + free (var.arr2->arr); + free (var.arr2); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c new file mode 100644 index 000000000000..cf8919c22edf --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c @@ -0,0 +1,87 @@ +/* { dg-do run { target c++ } } */ + +#include +#include +#include + +#define N 64 + +typedef struct { + int *arr; + int size; +} B; + +#pragma omp declare mapper (samename : B myb) map(to: myb.size, myb.arr) \ + map(tofrom: myb.arr[0:myb.size]) + +typedef struct { + int *arr; + int size; +} C; + + +struct A { + int *arr1; + B *arr2; + C *arr3; +}; + +int +main (int argc, char *argv[]) +{ + struct A var; + + memset (&var, 0, sizeof var); + var.arr1 = (int *) calloc (N, sizeof (int)); + var.arr2 = (B *) malloc (sizeof (B)); + var.arr2->arr = (int *) calloc (N, sizeof (int)); + var.arr2->size = N; + var.arr3 = (C *) malloc (sizeof (C)); + var.arr3->arr = (int *) calloc (N, sizeof (int)); + var.arr3->size = N; + + { + #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \ + map(tofrom: x.arr1[0:N]) \ + map(mapper(samename), tofrom: x.arr2[0:1]) + #pragma omp target + { + for (int i = 0; i < N; i++) + { + var.arr1[i]++; + var.arr2->arr[i]++; + } + } + } + + { + #pragma omp declare mapper (samename : C myc) map(to: myc.size, myc.arr) \ + map(tofrom: myc.arr[0:myc.size]) + #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr3) \ + map(tofrom: x.arr1[0:N]) \ + map(mapper(samename), tofrom: *x.arr3) + #pragma omp target + { + for (int i = 0; i < N; i++) + { + var.arr1[i]++; + var.arr3->arr[i]++; + } + } + } + + for (int i = 0; i < N; i++) + { + assert (var.arr1[i] == 2); + assert (var.arr2->arr[i] == 1); + assert (var.arr3->arr[i] == 1); + } + + free (var.arr1); + free (var.arr2->arr); + free (var.arr2); + free (var.arr3->arr); + free (var.arr3); + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c new file mode 100644 index 000000000000..99b7eedad90f --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c @@ -0,0 +1,55 @@ +/* { dg-do run { target c++ } } */ + +#include + +struct T { + int a; + int b; + int c; +}; + +void foo (void) +{ + struct T x; + x.a = x.b = x.c = 0; + +#pragma omp target + { + x.a++; + x.c++; + } + + assert (x.a == 1); + assert (x.b == 0); + assert (x.c == 1); +} + +// An identity mapper. This should do the same thing as the default! +#pragma omp declare mapper (struct T v) map(v) + +void bar (void) +{ + struct T x; + x.a = x.b = x.c = 0; + +#pragma omp target + { + x.b++; + } + +#pragma omp target map(x) + { + x.a++; + } + + assert (x.a == 1); + assert (x.b == 1); + assert (x.c == 0); +} + +int main (int argc, char *argv[]) +{ + foo (); + bar (); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c new file mode 100644 index 000000000000..e7108da25fef --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c @@ -0,0 +1,57 @@ +/* { dg-do run { target c++ } } */ + +#include +#include + +struct Z { + int *arr; +}; + +void baz (struct Z *zarr, int len) +{ +#pragma omp declare mapper (struct Z myvar) map(to: myvar.arr) \ + map(tofrom: myvar.arr[0:len]) + zarr[0].arr = (int *) calloc (len, sizeof (int)); + zarr[5].arr = (int *) calloc (len, sizeof (int)); + +#pragma omp target map(zarr, *zarr) + { + for (int i = 0; i < len; i++) + zarr[0].arr[i]++; + } + +#pragma omp target map(zarr, zarr[5]) + { + for (int i = 0; i < len; i++) + zarr[5].arr[i]++; + } + +#pragma omp target map(zarr[5]) + { + for (int i = 0; i < len; i++) + zarr[5].arr[i]++; + } + +#pragma omp target map(zarr, zarr[5:1]) + { + for (int i = 0; i < len; i++) + zarr[5].arr[i]++; + } + + for (int i = 0; i < len; i++) + assert (zarr[0].arr[i] == 1); + + for (int i = 0; i < len; i++) + assert (zarr[5].arr[i] == 3); + + free (zarr[5].arr); + free (zarr[0].arr); +} + +int +main (int argc, char *argv[]) +{ + struct Z myzarr[10]; + baz (myzarr, 256); + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c new file mode 100644 index 000000000000..9f85df53998a --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c @@ -0,0 +1,62 @@ +/* { dg-do run { target c++ } } */ + +#include +#include +#include + +#define N 64 + +struct A { + int *arr1; + float *arr2; + int arr3[N]; +}; + +int +main (int argc, char *argv[]) +{ + struct A var; + + memset (&var, 0, sizeof var); + var.arr1 = (int *) calloc (N, sizeof (int)); + var.arr2 = (float *) calloc (N, sizeof (float)); + + { + #pragma omp declare mapper (struct A x) map(to: x.arr1) \ + map(tofrom: x.arr1[0:N]) + #pragma omp target + { + for (int i = 0; i < N; i++) + var.arr1[i]++; + } + } + + { + #pragma omp declare mapper (struct A x) map(to: x.arr2) \ + map(tofrom: x.arr2[0:N]) + #pragma omp target + { + for (int i = 0; i < N; i++) + var.arr2[i]++; + } + } + + { + #pragma omp declare mapper (struct A x) map(tofrom: x.arr3[0:N]) + #pragma omp target + { + for (int i = 0; i < N; i++) + var.arr3[i]++; + } + } + + for (int i = 0; i < N; i++) + { + assert (var.arr1[i] == 1); + assert (var.arr2[i] == 1); + assert (var.arr3[i] == 1); + } + + free (var.arr1); + free (var.arr2); +} From patchwork Tue Sep 5 19:28:24 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830099 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=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 4RgFw23g8Tz1ygx for ; Wed, 6 Sep 2023 05:30:26 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 50F713882AF5 for ; Tue, 5 Sep 2023 19:30:24 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id D36A4385700C; Tue, 5 Sep 2023 19:29:09 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D36A4385700C 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="6.02,229,1688457600"; d="scan'208";a="16179086" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:29:04 -0800 IronPort-SDR: kSNJ0q/IzOcPA1XhLM7yUG4wUqTmhl0cAi5J1kDrlns3WO4W3gsMB8XLzWBSU7VjucJqHvrqrr Plg+HZ09Td9fscV3rss03XPR+3V/KYAPOj0amffU2/Mb/O3OTBKYJ5KufwYkwg9M3uMuoCWIiE uEA5DKe828n0gEZCTD8XAh0JKp7jQq6+PWz5eTxKxtUQTuHs7umJDv8hIM9bS5SDBHgSz8fMxI dhp70rNwfT4kJb8hdZyMSqC8HZFclw34VLFGlD+fgxDg8OtU3Cns7jCDtjiy5L1T/fv4qU+9dg DuI= From: Julian Brown To: CC: , , Subject: [PATCH 4/8] OpenMP: Support OpenMP 5.0 "declare mapper" directives for C Date: Tue, 5 Sep 2023 12:28:24 -0700 Message-ID: <8dec2802115e44fcd7d18b83729a44fa09c90b38.1693941293.git.julian@codesourcery.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: 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.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, KAM_STOCKGEN, SPF_HELO_PASS, 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 Sender: "Gcc-patches" This patch adds support for "declare mapper" directives (and the "mapper" modifier on "map" clauses) for C. It was previously posted for mainline here: https://gcc.gnu.org/pipermail/gcc-patches/2022-December/609041.html and for the og13 branch here: https://gcc.gnu.org/pipermail/gcc-patches/2023-June/623356.html This version supports mappers on "target data", "target enter data" and "target exit data" directives as well as on "target" directives. 2023-09-05 Julian Brown gcc/c/ * c-decl.cc (c_omp_mapper_id, c_omp_mapper_decl, c_omp_mapper_lookup, c_omp_extract_mapper_directive, c_omp_map_array_section, c_omp_scan_mapper_bindings_r, c_omp_scan_mapper_bindings): New functions. * c-objc-common.h (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES, LANG_HOOKS_OMP_MAPPER_LOOKUP, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE, LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define langhooks for C. * c-parser.cc (c_parser_omp_clause_map): Add KIND parameter. Handle mapper modifier. (c_parser_omp_all_clauses): Update call to c_parser_omp_clause_map with new kind argument. (c_parser_omp_target_data, c_parser_omp_target_enter_data, c_parser_omp_target_exit_data): Instantiate explicit mappers. (c_parser_omp_target): Instantiate explicit mappers and record bindings for implicit mappers. (c_parser_omp_declare_mapper): Parse "declare mapper" directives. (c_parser_omp_declare): Support "declare mapper". * c-tree.h (c_omp_finish_mapper_clauses, c_omp_mapper_lookup, c_omp_extract_mapper_directive, c_omp_map_array_section, c_omp_mapper_id, c_omp_mapper_decl, c_omp_scan_mapper_bindings): Add prototypes. * c-typeck.cc (c_finish_omp_clauses): Handle GOMP_MAP_PUSH_MAPPER_NAME and GOMP_MAP_POP_MAPPER_NAME. (c_omp_finish_mapper_clauses): New function (langhook). gcc/testsuite/ * c-c++-common/gomp/declare-mapper-3.c: Enable for C. * c-c++-common/gomp/declare-mapper-4.c: Likewise. * c-c++-common/gomp/declare-mapper-5.c: Likewise. * c-c++-common/gomp/declare-mapper-6.c: Likewise. * c-c++-common/gomp/declare-mapper-7.c: Likewise. * c-c++-common/gomp/declare-mapper-8.c: Likewise. * c-c++-common/gomp/declare-mapper-9.c: Likewise. * c-c++-common/gomp/declare-mapper-12.c: Likewise. * c-c++-common/gomp/declare-mapper-15.c: Likewise. * c-c++-common/gomp/declare-mapper-16.c: Likewise. * gcc.dg/gomp/declare-mapper-10.c: New test. * gcc.dg/gomp/declare-mapper-11.c: New test. libgomp/ * testsuite/libgomp.c-c++-common/declare-mapper-9.c: Enable for C. * testsuite/libgomp.c-c++-common/declare-mapper-10.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-11.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-12.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-13.c: Likewise. * testsuite/libgomp.c-c++-common/declare-mapper-14.c: Likewise. --- gcc/c/c-decl.cc | 169 ++++++++++ gcc/c/c-objc-common.h | 12 + gcc/c/c-parser.cc | 291 ++++++++++++++++-- gcc/c/c-tree.h | 7 + gcc/c/c-typeck.cc | 15 + .../c-c++-common/gomp/declare-mapper-12.c | 2 +- .../c-c++-common/gomp/declare-mapper-15.c | 2 +- .../c-c++-common/gomp/declare-mapper-16.c | 2 +- .../c-c++-common/gomp/declare-mapper-3.c | 2 +- .../c-c++-common/gomp/declare-mapper-4.c | 2 +- .../c-c++-common/gomp/declare-mapper-5.c | 2 +- .../c-c++-common/gomp/declare-mapper-6.c | 2 +- .../c-c++-common/gomp/declare-mapper-7.c | 2 +- .../c-c++-common/gomp/declare-mapper-8.c | 2 +- .../c-c++-common/gomp/declare-mapper-9.c | 2 +- gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c | 61 ++++ gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c | 33 ++ .../libgomp.c-c++-common/declare-mapper-10.c | 2 +- .../libgomp.c-c++-common/declare-mapper-11.c | 2 +- .../libgomp.c-c++-common/declare-mapper-12.c | 2 +- .../libgomp.c-c++-common/declare-mapper-13.c | 2 +- .../libgomp.c-c++-common/declare-mapper-14.c | 2 +- .../libgomp.c-c++-common/declare-mapper-9.c | 2 +- 23 files changed, 584 insertions(+), 36 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c create mode 100644 gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c diff --git a/gcc/c/c-decl.cc b/gcc/c/c-decl.cc index 1f9eb44dbaa2..ac71092fcad6 100644 --- a/gcc/c/c-decl.cc +++ b/gcc/c/c-decl.cc @@ -13144,6 +13144,175 @@ c_check_omp_declare_reduction_r (tree *tp, int *, void *data) return NULL_TREE; } +/* Return identifier to look up for omp declare reduction. */ + +tree +c_omp_mapper_id (tree mapper_id) +{ + const char *p = NULL; + + const char prefix[] = "omp declare mapper "; + + if (mapper_id == NULL_TREE) + p = ""; + else if (TREE_CODE (mapper_id) == IDENTIFIER_NODE) + p = IDENTIFIER_POINTER (mapper_id); + else + return error_mark_node; + + size_t lenp = sizeof (prefix); + size_t len = strlen (p); + char *name = XALLOCAVEC (char, lenp + len); + memcpy (name, prefix, lenp - 1); + memcpy (name + lenp - 1, p, len + 1); + return get_identifier (name); +} + +/* Lookup MAPPER_ID in the current scope, or create an artificial + VAR_DECL, bind it into the current scope and return it. */ + +tree +c_omp_mapper_decl (tree mapper_id) +{ + struct c_binding *b = I_SYMBOL_BINDING (mapper_id); + if (b != NULL && B_IN_CURRENT_SCOPE (b)) + return b->decl; + + tree decl = build_decl (BUILTINS_LOCATION, VAR_DECL, + mapper_id, integer_type_node); + DECL_ARTIFICIAL (decl) = 1; + DECL_EXTERNAL (decl) = 1; + TREE_STATIC (decl) = 1; + TREE_PUBLIC (decl) = 0; + bind (mapper_id, decl, current_scope, true, false, BUILTINS_LOCATION); + return decl; +} + +/* Lookup MAPPER_ID in the first scope where it has entry for TYPE. */ + +tree +c_omp_mapper_lookup (tree mapper_id, tree type) +{ + if (TREE_CODE (type) != RECORD_TYPE + && TREE_CODE (type) != UNION_TYPE) + return NULL_TREE; + + mapper_id = c_omp_mapper_id (mapper_id); + + struct c_binding *b = I_SYMBOL_BINDING (mapper_id); + while (b) + { + tree t; + for (t = DECL_INITIAL (b->decl); t; t = TREE_CHAIN (t)) + if (comptypes (TREE_PURPOSE (t), type)) + return TREE_VALUE (t); + b = b->shadowed; + } + return NULL_TREE; +} + +/* For C, we record a pointer to the mapper itself without wrapping it in an + artificial function or similar. So, just return it. */ + +tree +c_omp_extract_mapper_directive (tree mapper) +{ + return mapper; +} + +/* For now we can handle singleton OMP_ARRAY_SECTIONs with custom mappers, but + nothing more complicated. */ + +tree +c_omp_map_array_section (location_t loc, tree t) +{ + tree low = TREE_OPERAND (t, 1); + tree len = TREE_OPERAND (t, 2); + + if (len && integer_onep (len)) + { + t = TREE_OPERAND (t, 0); + + if (!low) + low = integer_zero_node; + + t = build_array_ref (loc, t, low); + } + + return t; +} + +/* Helper function for below function. */ + +static tree +c_omp_scan_mapper_bindings_r (tree *tp, int *walk_subtrees, void *ptr) +{ + tree t = *tp; + omp_mapper_list *mlist = (omp_mapper_list *) ptr; + tree aggr_type = NULL_TREE; + + if (TREE_CODE (t) == SIZEOF_EXPR + || TREE_CODE (t) == ALIGNOF_EXPR) + { + *walk_subtrees = 0; + return NULL_TREE; + } + + if (TREE_CODE (t) == OMP_CLAUSE) + return NULL_TREE; + + if (TREE_CODE (t) == COMPONENT_REF + && AGGREGATE_TYPE_P (TREE_TYPE (TREE_OPERAND (t, 0)))) + aggr_type = TREE_TYPE (TREE_OPERAND (t, 0)); + else if ((TREE_CODE (t) == VAR_DECL + || TREE_CODE (t) == PARM_DECL + || TREE_CODE (t) == RESULT_DECL) + && AGGREGATE_TYPE_P (TREE_TYPE (t))) + aggr_type = TREE_TYPE (t); + + if (aggr_type) + { + tree mapper_fn = c_omp_mapper_lookup (NULL_TREE, aggr_type); + if (mapper_fn) + mlist->add_mapper (NULL_TREE, aggr_type, mapper_fn); + } + + return NULL_TREE; +} + +/* Scan an offload region's body, and record uses of struct- or union-typed + variables. Add _mapper_binding_ fake clauses to *CLAUSES_PTR. */ + +void +c_omp_scan_mapper_bindings (location_t loc, tree *clauses_ptr, tree body) +{ + hash_set> seen_types; + auto_vec mappers; + omp_mapper_list mlist (&seen_types, &mappers); + + walk_tree_without_duplicates (&body, c_omp_scan_mapper_bindings_r, &mlist); + + unsigned int i; + tree mapper; + FOR_EACH_VEC_ELT (mappers, i, mapper) + c_omp_find_nested_mappers (&mlist, mapper); + + FOR_EACH_VEC_ELT (mappers, i, mapper) + { + if (mapper == error_mark_node) + continue; + tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper); + tree decl = OMP_DECLARE_MAPPER_DECL (mapper); + + tree c = build_omp_clause (loc, OMP_CLAUSE__MAPPER_BINDING_); + OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name; + OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl; + OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapper; + + OMP_CLAUSE_CHAIN (c) = *clauses_ptr; + *clauses_ptr = c; + } +} bool c_check_in_current_scope (tree decl) diff --git a/gcc/c/c-objc-common.h b/gcc/c/c-objc-common.h index d31dacb9dd47..423b0d3f434c 100644 --- a/gcc/c/c-objc-common.h +++ b/gcc/c/c-objc-common.h @@ -122,6 +122,18 @@ along with GCC; see the file COPYING3. If not see #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP c_omp_clause_copy_ctor +#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES +#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES c_omp_finish_mapper_clauses + +#undef LANG_HOOKS_OMP_MAPPER_LOOKUP +#define LANG_HOOKS_OMP_MAPPER_LOOKUP c_omp_mapper_lookup + +#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE +#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE c_omp_extract_mapper_directive + +#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION +#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION c_omp_map_array_section + #undef LANG_HOOKS_TREE_INLINING_VAR_MOD_TYPE_P #define LANG_HOOKS_TREE_INLINING_VAR_MOD_TYPE_P c_var_mod_p #endif /* GCC_C_OBJC_COMMON */ diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 36215096af4c..35b9ba6f2f0c 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -17321,10 +17321,9 @@ c_parser_omp_clause_doacross (c_parser *parser, tree list) always | close */ static tree -c_parser_omp_clause_map (c_parser *parser, tree list) +c_parser_omp_clause_map (c_parser *parser, tree list, enum gomp_map_kind kind) { location_t clause_loc = c_parser_peek_token (parser)->location; - enum gomp_map_kind kind = GOMP_MAP_TOFROM; tree nl, c; matching_parens parens; @@ -17343,12 +17342,26 @@ c_parser_omp_clause_map (c_parser *parser, tree list) if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COMMA) pos++; + else if (c_parser_peek_nth_token_raw (parser, pos + 1)->type + == CPP_OPEN_PAREN) + { + unsigned int npos = pos + 2; + if (c_parser_check_balanced_raw_token_sequence (parser, &npos) + && (c_parser_peek_nth_token_raw (parser, npos)->type + == CPP_CLOSE_PAREN) + && (c_parser_peek_nth_token_raw (parser, npos + 1)->type + == CPP_COMMA)) + pos = npos + 1; + } + pos++; } int always_modifier = 0; int close_modifier = 0; int present_modifier = 0; + int mapper_modifier = 0; + tree mapper_name = NULL_TREE; for (int pos = 1; pos < map_kind_pos; ++pos) { c_token *tok = c_parser_peek_token (parser); @@ -17369,6 +17382,7 @@ c_parser_omp_clause_map (c_parser *parser, tree list) return list; } always_modifier++; + c_parser_consume_token (parser); } else if (strcmp ("close", p) == 0) { @@ -17379,6 +17393,60 @@ c_parser_omp_clause_map (c_parser *parser, tree list) return list; } close_modifier++; + c_parser_consume_token (parser); + } + else if (strcmp ("mapper", p) == 0) + { + c_parser_consume_token (parser); + + matching_parens mparens; + if (mparens.require_open (parser)) + { + if (mapper_modifier) + { + c_parser_error (parser, "too many % modifiers"); + /* Assume it's a well-formed mapper modifier, even if it + seems to be in the wrong place. */ + c_parser_consume_token (parser); + mparens.require_close (parser); + parens.skip_until_found_close (parser); + return list; + } + + tok = c_parser_peek_token (parser); + + switch (tok->type) + { + case CPP_NAME: + { + mapper_name = tok->value; + c_parser_consume_token (parser); + } + break; + + case CPP_KEYWORD: + if (tok->keyword == RID_DEFAULT) + { + c_parser_consume_token (parser); + break; + } + /* Fallthrough. */ + + default: + error_at (tok->location, + "expected identifier or %"); + return list; + } + + if (!mparens.require_close (parser)) + { + parens.skip_until_found_close (parser); + return list; + } + + mapper_modifier++; + pos += 3; + } } else if (strcmp ("present", p) == 0) { @@ -17389,16 +17457,16 @@ c_parser_omp_clause_map (c_parser *parser, tree list) return list; } present_modifier++; + c_parser_consume_token (parser); } else { c_parser_error (parser, "% clause with map-type modifier other " - "than %, % or %"); + "than %, %, % or " + "%"); parens.skip_until_found_close (parser); return list; } - - c_parser_consume_token (parser); } if (c_parser_next_token_is (parser, CPP_NAME) @@ -17442,8 +17510,30 @@ c_parser_omp_clause_map (c_parser *parser, tree list) nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_MAP, list, true); + tree last_new = NULL_TREE; + for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) - OMP_CLAUSE_SET_MAP_KIND (c, kind); + { + OMP_CLAUSE_SET_MAP_KIND (c, kind); + last_new = c; + } + + if (mapper_name) + { + tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = mapper_name; + OMP_CLAUSE_CHAIN (name) = nl; + nl = name; + + gcc_assert (last_new); + + name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = null_pointer_node; + OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new); + OMP_CLAUSE_CHAIN (last_new) = name; + } parens.skip_until_found_close (parser); return nl; @@ -18269,7 +18359,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, c_name = "doacross"; break; case PRAGMA_OMP_CLAUSE_MAP: - clauses = c_parser_omp_clause_map (parser, clauses); + clauses = c_parser_omp_clause_map (parser, clauses, GOMP_MAP_TOFROM); c_name = "map"; break; case PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR: @@ -22051,7 +22141,9 @@ c_parser_omp_target_data (location_t loc, c_parser *parser, bool *if_p) tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_DATA_CLAUSE_MASK, - "#pragma omp target data"); + "#pragma omp target data", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -22208,7 +22300,9 @@ c_parser_omp_target_enter_data (location_t loc, c_parser *parser, tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_ENTER_DATA_CLAUSE_MASK, - "#pragma omp target enter data"); + "#pragma omp target enter data", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -22318,7 +22412,9 @@ c_parser_omp_target_exit_data (location_t loc, c_parser *parser, tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_EXIT_DATA_CLAUSE_MASK, - "#pragma omp target exit data"); + "#pragma omp target exit data", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_EXIT_DATA); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_EXIT_DATA); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -22408,7 +22504,7 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p) { location_t loc = c_parser_peek_token (parser)->location; c_parser_consume_pragma (parser); - tree *pc = NULL, stmt, block; + tree *pc = NULL, stmt, block, body, clauses; if (context != pragma_stmt && context != pragma_compound) { @@ -22563,10 +22659,9 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p) stmt = make_node (OMP_TARGET); TREE_TYPE (stmt) = void_type_node; - OMP_TARGET_CLAUSES (stmt) - = c_parser_omp_all_clauses (parser, OMP_TARGET_CLAUSE_MASK, - "#pragma omp target", false); - for (tree c = OMP_TARGET_CLAUSES (stmt); c; c = OMP_CLAUSE_CHAIN (c)) + clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_CLAUSE_MASK, + "#pragma omp target", false); + for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION) { tree nc = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); @@ -22575,14 +22670,19 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p) OMP_CLAUSE_CHAIN (nc) = OMP_CLAUSE_CHAIN (c); OMP_CLAUSE_CHAIN (c) = nc; } - OMP_TARGET_CLAUSES (stmt) - = c_finish_omp_clauses (OMP_TARGET_CLAUSES (stmt), C_ORT_OMP_TARGET); - c_omp_adjust_map_clauses (OMP_TARGET_CLAUSES (stmt), true); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_TARGET); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_TARGET); + c_omp_adjust_map_clauses (clauses, true); - pc = &OMP_TARGET_CLAUSES (stmt); keep_next_level (); block = c_begin_compound_stmt (true); - add_stmt (c_parser_omp_structured_block (parser, if_p)); + body = c_parser_omp_structured_block (parser, if_p); + + c_omp_scan_mapper_bindings (loc, &clauses, body); + + add_stmt (body); + OMP_TARGET_CLAUSES (stmt) = clauses; + pc = &OMP_TARGET_CLAUSES (stmt); OMP_TARGET_BODY (stmt) = c_end_compound_stmt (loc, block, true); SET_EXPR_LOCATION (stmt, loc); @@ -23891,6 +23991,151 @@ c_parser_omp_declare_reduction (c_parser *parser, enum pragma_context context) } +/* OpenMP 5.0 + #pragma omp declare mapper ([mapper-identifier :] type var) \ + [clause [ [,] clause ] ... ] new-line */ + +static void +c_parser_omp_declare_mapper (c_parser *parser, enum pragma_context context) +{ + tree type, mapper_name = NULL_TREE, var = NULL_TREE, stmt, stmtlist; + tree maplist = NULL_TREE, mapper_id, mapper_decl, t; + c_token *token; + + if (context == pragma_struct || context == pragma_param) + { + error ("%<#pragma omp declare reduction%> not at file or block scope"); + goto fail; + } + + if (!c_parser_require (parser, CPP_OPEN_PAREN, "expected %<(%>")) + goto fail; + + token = c_parser_peek_token (parser); + + if (c_parser_peek_2nd_token (parser)->type == CPP_COLON) + { + switch (token->type) + { + case CPP_NAME: + mapper_name = token->value; + c_parser_consume_token (parser); + break; + case CPP_KEYWORD: + if (token->keyword == RID_DEFAULT) + { + mapper_name = NULL_TREE; + c_parser_consume_token (parser); + break; + } + /* Fallthrough. */ + default: + error_at (token->location, "expected identifier or %"); + c_parser_skip_to_pragma_eol (parser, false); + return; + } + + if (!c_parser_require (parser, CPP_COLON, "expected %<:%>")) + goto fail; + } + + mapper_id = c_omp_mapper_id (mapper_name); + mapper_decl = c_omp_mapper_decl (mapper_id); + + { + location_t loc = c_parser_peek_token (parser)->location; + struct c_type_name *ctype = c_parser_type_name (parser); + type = groktypename (ctype, NULL, NULL); + if (type == error_mark_node) + goto fail; + if (TREE_CODE (type) != RECORD_TYPE + && TREE_CODE (type) != UNION_TYPE) + { + error_at (loc, "%qT is not a struct or union type in " + "%<#pragma omp declare mapper%>", type); + c_parser_skip_to_pragma_eol (parser, false); + return; + } + for (tree t = DECL_INITIAL (mapper_decl); t; t = TREE_CHAIN (t)) + if (comptypes (TREE_PURPOSE (t), type)) + { + error_at (loc, "redeclaration of %qs %<#pragma omp declare " + "mapper%> for type %qT", IDENTIFIER_POINTER (mapper_id) + + sizeof ("omp declare mapper ") - 1, + type); + tree prevmapper = TREE_VALUE (t); + /* Hmm, this location might not be very accurate. */ + location_t ploc + = DECL_SOURCE_LOCATION (OMP_DECLARE_MAPPER_DECL (prevmapper)); + error_at (ploc, "previous %<#pragma omp declare mapper%>"); + c_parser_skip_to_pragma_eol (parser, false); + return; + } + } + + token = c_parser_peek_token (parser); + if (token->type == CPP_NAME) + { + var = build_decl (token->location, VAR_DECL, token->value, type); + c_parser_consume_token (parser); + DECL_ARTIFICIAL (var) = 1; + } + else + { + error_at (token->location, "expected identifier"); + goto fail; + } + + if (!c_parser_require (parser, CPP_CLOSE_PAREN, "expected %<)%>")) + goto fail; + + push_scope (); + stmtlist = push_stmt_list (); + pushdecl (var); + DECL_CONTEXT (var) = current_function_decl; + + while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL)) + { + location_t here; + pragma_omp_clause c_kind; + here = c_parser_peek_token (parser)->location; + c_kind = c_parser_omp_clause_name (parser); + if (c_kind != PRAGMA_OMP_CLAUSE_MAP) + { + error_at (here, "unexpected clause"); + goto fail; + } + maplist = c_parser_omp_clause_map (parser, maplist, GOMP_MAP_UNSET); + } + + if (maplist == NULL_TREE) + { + error_at (input_location, "missing % clause"); + goto fail; + } + + stmt = make_node (OMP_DECLARE_MAPPER); + TREE_TYPE (stmt) = type; + OMP_DECLARE_MAPPER_ID (stmt) = mapper_name; + OMP_DECLARE_MAPPER_DECL (stmt) = var; + OMP_DECLARE_MAPPER_CLAUSES (stmt) = maplist; + + add_stmt (stmt); + + pop_stmt_list (stmtlist); + pop_scope (); + + c_parser_skip_to_pragma_eol (parser); + + t = tree_cons (type, stmt, DECL_INITIAL (mapper_decl)); + DECL_INITIAL (mapper_decl) = t; + + return; + + fail: + c_parser_skip_to_pragma_eol (parser); +} + /* OpenMP 4.0 #pragma omp declare simd declare-simd-clauses[optseq] new-line #pragma omp declare reduction (reduction-id : typename-list : expression) \ @@ -23920,6 +24165,12 @@ c_parser_omp_declare (c_parser *parser, enum pragma_context context) c_parser_omp_declare_reduction (parser, context); return false; } + if (strcmp (p, "mapper") == 0) + { + c_parser_consume_token (parser); + c_parser_omp_declare_mapper (parser, context); + return false; + } if (!flag_openmp) /* flag_openmp_simd */ { c_parser_skip_to_pragma_eol (parser, false); diff --git a/gcc/c/c-tree.h b/gcc/c/c-tree.h index 5cd507563695..d2cc975a5ba3 100644 --- a/gcc/c/c-tree.h +++ b/gcc/c/c-tree.h @@ -826,6 +826,10 @@ extern tree c_finish_omp_task (location_t, tree, tree); extern void c_finish_omp_cancel (location_t, tree); extern void c_finish_omp_cancellation_point (location_t, tree); extern tree c_finish_omp_clauses (tree, enum c_omp_region_type); +extern tree c_omp_finish_mapper_clauses (tree); +extern tree c_omp_mapper_lookup (tree, tree); +extern tree c_omp_extract_mapper_directive (tree); +extern tree c_omp_map_array_section (location_t, tree); extern tree c_build_va_arg (location_t, tree, location_t, tree); extern tree c_finish_transaction (location_t, tree, int); extern bool c_tree_equal (tree, tree); @@ -877,6 +881,9 @@ extern tree c_omp_reduction_id (enum tree_code, tree); extern tree c_omp_reduction_decl (tree); extern tree c_omp_reduction_lookup (tree, tree); extern tree c_check_omp_declare_reduction_r (tree *, int *, void *); +extern tree c_omp_mapper_id (tree); +extern tree c_omp_mapper_decl (tree); +extern void c_omp_scan_mapper_bindings (location_t, tree *, tree); extern bool c_check_in_current_scope (tree); extern void c_pushtag (location_t, tree, tree); extern void c_bind (location_t, tree, bool); diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc index b399341084d2..2696e681be4f 100644 --- a/gcc/c/c-typeck.cc +++ b/gcc/c/c-typeck.cc @@ -15336,6 +15336,12 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) case OMP_CLAUSE_MAP: if (OMP_CLAUSE_MAP_IMPLICIT (c) && !implicit_moved) goto move_implicit; + if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POP_MAPPER_NAME) + { + remove = true; + break; + } /* FALLTHRU */ case OMP_CLAUSE_TO: case OMP_CLAUSE_FROM: @@ -16180,6 +16186,15 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) return clauses; } +/* Do processing necessary to make CLAUSES well-formed, where CLAUSES result + from implicit instantiation of user-defined mappers (in gimplify.cc). */ + +tree +c_omp_finish_mapper_clauses (tree clauses) +{ + return c_finish_omp_clauses (clauses, C_ORT_OMP); +} + /* Return code to initialize DST with a copy constructor from SRC. C doesn't have copy constructors nor assignment operators, only for _Atomic vars we need to perform __atomic_load from src into a temporary diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c index c4d017036c5e..dffb19db03cd 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ struct XYZ { int a; diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c index 0db83b6fd335..ecda2e5ebd1a 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ /* { dg-options "-fopenmp -fdump-tree-gimple" } */ typedef struct { diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c index f8711f60a39a..20383cc2d69f 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ /* { dg-options "-fopenmp -fdump-tree-gimple" } */ typedef struct { diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c index 983d979d68c5..e491bcd0ce65 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c @@ -1,4 +1,4 @@ -// { dg-do compile { target c++ } } +// { dg-do compile } // { dg-additional-options "-fdump-tree-gimple" } #include diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c index 6d933e4bf6f4..39e3ab114199 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ /* { dg-additional-options "-fdump-tree-original" } */ /* Check mapper binding clauses. */ diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c index f675a8c68902..86f14e76cbf3 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ typedef struct S_ { int *myarr; diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c index a2f6c08cdfdd..c13eb8b5816e 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ int x = 5; diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c index 1b1be9dbb666..0f8dd25a18dc 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ struct Q { int *arr1; diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c index 86ddb942072c..dadca282711c 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ struct Q { int *arr1; diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c index 54e58426910e..b568c5a477f0 100644 --- a/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c +++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c @@ -1,4 +1,4 @@ -/* { dg-do compile { target c++ } } */ +/* { dg-do compile } */ int x = 5; diff --git a/gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c b/gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c new file mode 100644 index 000000000000..efc9c1369158 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c @@ -0,0 +1,61 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-fdump-tree-gimple" } */ + +// "omp declare mapper" support -- check expansion in gimple. + +#include + +struct S { + int *ptr; + int size; +}; + +#define N 64 + +#pragma omp declare mapper (struct S w) map(w.size, w.ptr, w.ptr[:w.size]) +#pragma omp declare mapper (foo:struct S w) map(to:w.size, w.ptr) \ + map(w.ptr[:w.size]) + +int main (int argc, char *argv[]) +{ + struct S s; + s.ptr = (int *) malloc (sizeof (int) * N); + s.size = N; + +#pragma omp declare mapper (bar:struct S w) map(w.size, w.ptr, w.ptr[:w.size]) + +#pragma omp target + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(tofrom: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(mapper(default), tofrom: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(mapper(foo), alloc: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + +#pragma omp target map(mapper(bar), tofrom: s) + { + for (int i = 0; i < N; i++) + s.ptr[i]++; + } + + return 0; +} + +/* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(tofrom:s\.ptr \[len: [0-9]+\]\) map\(tofrom:s\.size \[len: [0-9]+\]\) map\(tofrom:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 4 "gimple" { target c++ } } } */ +/* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(to:s\.ptr \[len: [0-9]+\]\) map\(to:s\.size \[len: [0-9]+\]\) map\(alloc:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 1 "gimple" { target c++ } } } */ diff --git a/gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c b/gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c new file mode 100644 index 000000000000..927065e5ea63 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c @@ -0,0 +1,33 @@ +// { dg-do compile } + +// Error-checking tests for "omp declare mapper". + +typedef struct { + int *ptr; + int size; +} S; + +typedef struct { + int z; +} Z; + +int main (int argc, char *argv[]) +{ +#pragma omp declare mapper (S v) map(v.size, v.ptr[:v.size]) +/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-1 } */ + + /* This one's a duplicate. */ +#pragma omp declare mapper (default: S v) map (to: v.size) map (v) +/* { dg-error "redeclaration of '' '#pragma omp declare mapper' for type 'S'" "" { target c } .-1 } */ + + /* ...and this one doesn't use a "base language identifier" for the mapper + name. */ +#pragma omp declare mapper (case: S v) map (to: v.size) +/* { dg-error "expected identifier or 'default'" "" { target c } .-1 } */ + + /* A non-struct/class/union type isn't supposed to work. */ +#pragma omp declare mapper (name:Z [5]foo) map (foo[0].z) +/* { dg-error "'Z\\\[5\\\]' is not a struct or union type in '#pragma omp declare mapper'" "" { target c } .-1 } */ + + return 0; +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c index b0fa40929fbc..ca5aef4d9d38 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c @@ -1,4 +1,4 @@ -/* { dg-do run { target c++ } } */ +/* { dg-do run } */ #include #include diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c index b509ddc412c5..942d6a5a6ad2 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c @@ -1,4 +1,4 @@ -/* { dg-do run { target c++ } } */ +/* { dg-do run } */ #include #include diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c index cf8919c22edf..cbedee51683f 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c @@ -1,4 +1,4 @@ -/* { dg-do run { target c++ } } */ +/* { dg-do run } */ #include #include diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c index 99b7eedad90f..c4784ebafdd5 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c @@ -1,4 +1,4 @@ -/* { dg-do run { target c++ } } */ +/* { dg-do run } */ #include diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c index e7108da25fef..3e6027e30508 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c @@ -1,4 +1,4 @@ -/* { dg-do run { target c++ } } */ +/* { dg-do run } */ #include #include diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c index 9f85df53998a..324d53567787 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c +++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c @@ -1,4 +1,4 @@ -/* { dg-do run { target c++ } } */ +/* { dg-do run } */ #include #include From patchwork Tue Sep 5 19:28:25 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830100 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=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 4RgFwb3Lpqz1ygx for ; Wed, 6 Sep 2023 05:30:55 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9BB193885C34 for ; Tue, 5 Sep 2023 19:30:49 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 923C0388215F; Tue, 5 Sep 2023 19:30:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 923C0388215F 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="6.02,229,1688457600"; d="scan'208";a="18105086" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:30:12 -0800 IronPort-SDR: gGOamSm+jIshwXY3olWiu2UTg1qQb1Wo9MNTd41UeKrI9EfY9FQ2WotnPe6/ZHxGQW+iDHnwDP REPPqbZQmmaCIFaa/0Hvvg07AI+zp0pxPtTsA15v1Ulcv2izrgDFnr44D9ivUgK1YDcNIPR24C Rhl69uJHF5axvIyt3L8hLuciPRukElzq8gSTAreIr3z1IpDMzo5ZosGqdGFGF6pT+qmV64IT+7 yHM3nrcsJJcLMgB4ceg2OUN1nxx8V/5ZkRPbtjgGEDojwUIsONWWEl1n6GIpRIeF+Lm1eYs4ko uQg= From: Julian Brown To: CC: , , Subject: [PATCH 5/8] OpenMP, Fortran: Pass list number to gfc_free_omp_namelist Date: Tue, 5 Sep 2023 12:28:25 -0700 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.8 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.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 Sender: "Gcc-patches" This is a cleanup to avoid passing an ever-longer list of boolean arguments to gfc_free_omp_namelist, in support of the Fortran "declare mapper" implementation further along this patch series. This patch isn't intended to cause any behavioural changes. 2023-09-05 Julian Brown gcc/fortran/ * gfortran.h (gfc_free_omp_namelist): Update prototype. * match.cc (gfc_free_omp_namelist): Remove FREE_NS, FREE_ALIGN_ALLOCATOR, FREE_MEM_TRAITS_SPACE parameters and replace with LIST. * openmp.cc (gfc_free_omp_clauses, gfc_match_omp_clause_reduction, gfc_match_omp_clause_uses_allocators, gfc_match_omp_clauses, gfc_match_omp_allocate, gfc_match_omp_flush, resolve_omp_clauses): Update calls to gfc_free_omp_namelist. * st.cc (gfc_free_statement): Update call to gfc_free_omp_namelist. --- gcc/fortran/gfortran.h | 2 +- gcc/fortran/match.cc | 7 ++++--- gcc/fortran/openmp.cc | 31 ++++++++++++++----------------- gcc/fortran/st.cc | 2 +- 4 files changed, 20 insertions(+), 22 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3c8270a0f83a..34ee800668ca 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3605,7 +3605,7 @@ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); void gfc_free_namelist (gfc_namelist *); -void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool); +void gfc_free_omp_namelist (gfc_omp_namelist *, int = OMP_LIST_NUM); void gfc_free_equiv (gfc_equiv *); void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *); void gfc_free_data (gfc_data *); diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index ba23bcd96923..dd72a03027a1 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -5536,10 +5536,11 @@ gfc_free_namelist (gfc_namelist *name) /* Free an OpenMP namelist structure. */ void -gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns, - bool free_align_allocator, - bool free_mem_traits_space) +gfc_free_omp_namelist (gfc_omp_namelist *name, int list) { + bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND); + bool free_align_allocator = (list == OMP_LIST_ALLOCATE); + bool free_mem_traits_space = (list == OMP_LIST_USES_ALLOCATORS); gfc_omp_namelist *n; for (; name; name = n) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 234d896b2ce2..576b6784b441 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -186,10 +186,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->num_workers_expr); 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_ALLOCATE, - i == OMP_LIST_USES_ALLOCATORS); + gfc_free_omp_namelist (c->lists[i], i); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); free (CONST_CAST (char *, c->critical_name)); @@ -554,7 +551,7 @@ syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_omp_namelist (head, false, false, false); + gfc_free_omp_namelist (head); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -644,7 +641,7 @@ syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_omp_namelist (head, false, false, false); + gfc_free_omp_namelist (head); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -753,7 +750,7 @@ syntax: gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C"); cleanup: - gfc_free_omp_namelist (head, false, false, false); + gfc_free_omp_namelist (head); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -1504,7 +1501,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, *head = NULL; gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L", buffer, &old_loc); - gfc_free_omp_namelist (n, false, false, false); + gfc_free_omp_namelist (n, list_idx); } else for (n = *head; n; n = n->next) @@ -1795,7 +1792,7 @@ gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c) return MATCH_YES; error: - gfc_free_omp_namelist (head, false, false, true); + gfc_free_omp_namelist (head, OMP_LIST_USES_ALLOCATORS); return MATCH_ERROR; } @@ -1922,7 +1919,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES) { - gfc_free_omp_namelist (*head, false, false, false); + gfc_free_omp_namelist (*head); gfc_current_locus = old_loc; *head = NULL; break; @@ -2865,7 +2862,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, end_colon = true; else if (gfc_match (" )") != MATCH_YES) { - gfc_free_omp_namelist (*head, false, false, false); + gfc_free_omp_namelist (*head); gfc_current_locus = old_loc; *head = NULL; break; @@ -2876,7 +2873,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, { if (gfc_match (" %e )", &step) != MATCH_YES) { - gfc_free_omp_namelist (*head, false, false, false); + gfc_free_omp_namelist (*head); gfc_current_locus = old_loc; *head = NULL; goto error; @@ -2973,7 +2970,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } if (has_error) { - gfc_free_omp_namelist (*head, false, false, false); + gfc_free_omp_namelist (*head); *head = NULL; goto error; } @@ -4519,7 +4516,7 @@ gfc_match_omp_allocate (void) gfc_error ("Unexpected expression as list item at %L in ALLOCATE " "directive", &n->expr->where); - gfc_free_omp_namelist (vars, false, true, false); + gfc_free_omp_namelist (vars, OMP_LIST_ALLOCATE); goto error; } @@ -4923,14 +4920,14 @@ gfc_match_omp_flush (void) { gfc_error ("List specified together with memory order clause in FLUSH " "directive at %C"); - gfc_free_omp_namelist (list, false, false, false); + gfc_free_omp_namelist (list); gfc_free_omp_clauses (c); return MATCH_ERROR; } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); - gfc_free_omp_namelist (list, false, false, false); + gfc_free_omp_namelist (list); gfc_free_omp_clauses (c); return MATCH_ERROR; } @@ -7831,7 +7828,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, { prev->next = n->next; n->next = NULL; - gfc_free_omp_namelist (n, false, true, false); + gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE); n = prev->next; } continue; diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc index b6d87c402074..257e08bc074c 100644 --- a/gcc/fortran/st.cc +++ b/gcc/fortran/st.cc @@ -288,7 +288,7 @@ gfc_free_statement (gfc_code *p) break; case EXEC_OMP_FLUSH: - gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false); + gfc_free_omp_namelist (p->ext.omp_namelist); break; case EXEC_OMP_BARRIER: From patchwork Tue Sep 5 19:28:26 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830101 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=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 4RgFwf4gKjz1ygx for ; Wed, 6 Sep 2023 05:30:58 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 628C53896C07 for ; Tue, 5 Sep 2023 19:30:52 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 226293882667; Tue, 5 Sep 2023 19:30:16 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 226293882667 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="6.02,229,1688457600"; d="scan'208";a="18105091" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:30:15 -0800 IronPort-SDR: wYf8wMraZOc48qKyeKTNBrl8UF/59D4Bw8h9apar5ywS6bDDCKcTz9TeKs7IpxMs1PRdQnqTV6 398uqU8DCI/LUdtBsadRl+Ww/DDNdQsZyuQfNsVGP/0Rnq7Y3Yk6plIe4w/FJQDdyuKUH4Hxqs KpY5RmP0iH1yCxgTRGA9udFqcfpojFxduJpEgETyoYric6lepVtIBlnVCYR0gapTKyUPh6Q2Wx ftd8Y+aypyhxRHs0h8JC6gc/NE89TlhqX1j96GfnCvg11oRLH199ziRcNoTVqaX8WmV46hbvJI 9QI= From: Julian Brown To: CC: , , Subject: [PATCH 6/8] OpenMP, Fortran: Per-directive control for gfc_trans_omp_clauses Date: Tue, 5 Sep 2023 12:28:26 -0700 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.8 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.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 Sender: "Gcc-patches" Some of the processing done by gfc_trans_omp_clauses depends on the directive that that clause is attached to. This patch refactors two booleans and one gfc_exec_op parameter for gfc_trans_omp_clauses into a single parameter of (new) enumerated type 'toc_directive'. The same parameter is also passed to gfc_trans_omp_array_section instead of a gfc_exec_op type parameter and an 'openmp' boolean. This is mostly done in aid of the patch later in the series implementing "declare mapper" support for Fortran. There shouldn't be any behavioural changes introduced by this patch. 2023-09-05 Julian Brown gcc/fortran/ * gfortran.h (toc_directive): New enum. * trans-openmp.cc (gfc_trans_omp_array_section): Take toc_directive parameter instead of gfc_exec_op and 'openmp' boolean. (gfc_trans_omp_clauses): Take toc_directive parameter instead of 'declare_simd', 'openacc' and gfc_exec_op 'op' parameters. (gfc_trans_oacc_construct, gfc_trans_oacc_executable_directive, gfc_trans_oacc_combined_directive, gfc_trans_omp_target_exit_data, gfc_trans_oacc_declare, gfc_trans_omp_declare_simd, gfc_trans_omp_declare_variant): Update calls to gfc_trans_omp_clauses. --- gcc/fortran/gfortran.h | 11 ++++++ gcc/fortran/trans-openmp.cc | 77 +++++++++++++++++++------------------ 2 files changed, 50 insertions(+), 38 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 34ee800668ca..3070b4675e8e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3180,6 +3180,17 @@ typedef struct gfc_finalizer gfc_finalizer; #define gfc_get_finalizer() XCNEW (gfc_finalizer) +/* Control clause translation per-directive for gfc_trans_omp_clauses. Also + used for gfc_omp_instantiate_mappers. */ + +enum toc_directive +{ + TOC_OPENMP, + TOC_OPENMP_DECLARE_SIMD, + TOC_OPENMP_EXIT_DATA, + TOC_OPENACC, + TOC_OPENACC_DECLARE +}; /************************ Function prototypes *************************/ diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index a9dc1a617be5..829b28b24c79 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2404,11 +2404,13 @@ static vec *doacross_steps; /* Translate an array section or array element. */ static void -gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op, +gfc_trans_omp_array_section (stmtblock_t *block, toc_directive cd, gfc_omp_namelist *n, tree decl, bool element, - bool openmp, gomp_map_kind ptr_kind, tree &node, + gomp_map_kind ptr_kind, tree &node, tree &node2, tree &node3, tree &node4) { + bool openmp = (cd < TOC_OPENACC); + bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA); gfc_se se; tree ptr, ptr2; tree elemsz = NULL_TREE; @@ -2460,7 +2462,7 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op, if (POINTER_TYPE_P (TREE_TYPE (decl)) && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))) && ptr_kind == GOMP_MAP_POINTER - && op != EXEC_OMP_TARGET_EXIT_DATA + && !omp_exit_data && OMP_CLAUSE_MAP_KIND (node) != GOMP_MAP_RELEASE && OMP_CLAUSE_MAP_KIND (node) != GOMP_MAP_DELETE) @@ -2479,8 +2481,7 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op, gomp_map_kind map_kind; if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE) map_kind = OMP_CLAUSE_MAP_KIND (node); - else if (op == EXEC_OMP_TARGET_EXIT_DATA - || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE) + else if (omp_exit_data || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE) map_kind = GOMP_MAP_RELEASE; else map_kind = GOMP_MAP_TO; @@ -2499,11 +2500,10 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op, OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE - || op == EXEC_OMP_TARGET_EXIT_DATA) + || omp_exit_data) { - gomp_map_kind map_kind - = (op == EXEC_OMP_TARGET_EXIT_DATA) ? GOMP_MAP_RELEASE - : OMP_CLAUSE_MAP_KIND (node); + gomp_map_kind map_kind = omp_exit_data ? GOMP_MAP_RELEASE + : OMP_CLAUSE_MAP_KIND (node); OMP_CLAUSE_SET_MAP_KIND (node2, map_kind); OMP_CLAUSE_RELEASE_DESCRIPTOR (node2) = 1; } @@ -2681,9 +2681,11 @@ get_symbol_rooted_namelist (hash_map= TOC_OPENACC); + bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA); tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c; tree iterator = NULL_TREE; tree tree_block = NULL_TREE; @@ -3250,7 +3252,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, && n->sym->ts.deferred && n->sym->attr.omp_declare_target && (always_modifier || n->sym->attr.pointer) - && op != EXEC_OMP_TARGET_EXIT_DATA + && !omp_exit_data && n->u.map_op != OMP_MAP_DELETE && n->u.map_op != OMP_MAP_RELEASE) { @@ -3313,14 +3315,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, NULL_TREE)); } /* For descriptor types, the unmapping happens below. */ - if (op != EXEC_OMP_TARGET_EXIT_DATA + if (!omp_exit_data || !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) { enum gomp_map_kind gmk = GOMP_MAP_POINTER; - if (op == EXEC_OMP_TARGET_EXIT_DATA - && n->u.map_op == OMP_MAP_DELETE) + if (omp_exit_data && n->u.map_op == OMP_MAP_DELETE) gmk = GOMP_MAP_DELETE; - else if (op == EXEC_OMP_TARGET_EXIT_DATA) + else if (omp_exit_data) gmk = GOMP_MAP_RELEASE; tree size; if (gmk == GOMP_MAP_RELEASE || gmk == GOMP_MAP_DELETE) @@ -3340,10 +3341,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl))) { enum gomp_map_kind gmk; - if (op == EXEC_OMP_TARGET_EXIT_DATA - && n->u.map_op == OMP_MAP_DELETE) + if (omp_exit_data && n->u.map_op == OMP_MAP_DELETE) gmk = GOMP_MAP_DELETE; - else if (op == EXEC_OMP_TARGET_EXIT_DATA) + else if (omp_exit_data) gmk = GOMP_MAP_RELEASE; else gmk = GOMP_MAP_POINTER; @@ -3375,14 +3375,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); if (n->u.map_op == OMP_MAP_DELETE) map_kind = GOMP_MAP_DELETE; - else if (op == EXEC_OMP_TARGET_EXIT_DATA - || n->u.map_op == OMP_MAP_RELEASE) + else if (omp_exit_data || n->u.map_op == OMP_MAP_RELEASE) map_kind = GOMP_MAP_RELEASE; else map_kind = GOMP_MAP_TO_PSET; OMP_CLAUSE_SET_MAP_KIND (node2, map_kind); - if (op != EXEC_OMP_TARGET_EXIT_DATA + if (!omp_exit_data && n->u.map_op != OMP_MAP_DELETE && n->u.map_op != OMP_MAP_RELEASE) { @@ -3581,9 +3580,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, - !openacc, k, node, node2, - node3, node4); + gfc_trans_omp_array_section (block, cd, n, decl, element, + k, node, node2, node3, node4); } else if (n->expr && n->expr->expr_type == EXPR_VARIABLE @@ -3643,7 +3641,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gomp_map_kind kind; if (n->u.map_op == OMP_MAP_DELETE) kind = GOMP_MAP_DELETE; - else if (op == EXEC_OMP_TARGET_EXIT_DATA) + else if (omp_exit_data) kind = GOMP_MAP_RELEASE; else kind = GOMP_MAP_TO; @@ -3828,7 +3826,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, else if (n->u.map_op == OMP_MAP_RELEASE || n->u.map_op == OMP_MAP_DELETE) ; - else if (op == EXEC_OMP_TARGET_EXIT_DATA) + else if (omp_exit_data) map_kind = GOMP_MAP_RELEASE; else map_kind = GOMP_MAP_ALLOC; @@ -3968,9 +3966,9 @@ 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, - !openacc, kind, node, node2, - node3, node4); + gfc_trans_omp_array_section (block, cd, n, inner, element, + kind, node, node2, node3, + node4); } else gcc_unreachable (); @@ -4906,7 +4904,7 @@ gfc_trans_oacc_construct (gfc_code *code) gfc_start_block (&block); oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, - code->loc, false, true); + code->loc, TOC_OPENACC); pushlevel (); stmt = gfc_trans_omp_code (code->block->next, true); stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -4944,7 +4942,7 @@ gfc_trans_oacc_executable_directive (gfc_code *code) gfc_start_block (&block); oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, - code->loc, false, true, code->op); + code->loc, TOC_OPENACC); stmt = build1_loc (input_location, construct_code, void_type_node, oacc_clauses); gfc_add_expr_to_block (&block, stmt); @@ -6143,7 +6141,7 @@ gfc_trans_oacc_combined_directive (gfc_code *code) if (construct_code == OACC_KERNELS) construct_clauses.lists[OMP_LIST_REDUCTION] = NULL; oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses, - code->loc, false, true); + code->loc, TOC_OPENACC); } if (!loop_clauses.seq) pblock = █ @@ -7889,7 +7887,7 @@ gfc_trans_omp_target_exit_data (gfc_code *code) gfc_start_block (&block); omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, - code->loc, false, false, code->op); + code->loc, TOC_OPENMP_EXIT_DATA); stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node, omp_clauses); gfc_add_expr_to_block (&block, stmt); @@ -8088,7 +8086,7 @@ gfc_trans_oacc_declare (gfc_code *code) gfc_start_block (&block); oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses, - code->loc, false, true); + code->loc, TOC_OPENACC_DECLARE); stmt = gfc_trans_omp_code (code->block->next, true); stmt = build2_loc (input_location, construct_code, void_type_node, stmt, oacc_clauses); @@ -8262,7 +8260,8 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns) gfc_omp_declare_simd *ods; for (ods = ns->omp_declare_simd; ods; ods = ods->next) { - tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true); + tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, + TOC_OPENMP_DECLARE_SIMD); tree fndecl = ns->proc_name->backend_decl; if (c != NULL_TREE) c = tree_cons (NULL_TREE, c, NULL_TREE); @@ -8389,8 +8388,10 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns) } break; case CTX_PROPERTY_SIMD: - properties = gfc_trans_omp_clauses (NULL, otp->clauses, - odv->where, true); + properties + = gfc_trans_omp_clauses (NULL, otp->clauses, + odv->where, + TOC_OPENMP_DECLARE_SIMD); break; default: gcc_unreachable (); From patchwork Tue Sep 5 19:28:27 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830103 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=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 4RgFxF2tQKz1ygx for ; Wed, 6 Sep 2023 05:31:29 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7157C385483A for ; Tue, 5 Sep 2023 19:31:27 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id AD2633882AE8; Tue, 5 Sep 2023 19:30:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org AD2633882AE8 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="6.02,229,1688457600"; d="scan'208";a="18105093" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:30:18 -0800 IronPort-SDR: XAhDSxPmhS2aCqcjD58A/kxgeL69uWIT5BFjaCaUPM8vWKh8FKxvhoNZNQkAXR0S5RSaet5VTD jFkExhg9HrxEfV5t70usRrJGp82lCdnACI6vG6Z9p9rJKs0PG5MnMkJWnIKswJ0tL3Yt/FxEIh oMZ8t19pqYO81yCctkH4F0A7i1ZRp4wM6Mukd1B/meR9diMFkCd+pcUXW1+5UDkjNfIm1JBKXW 5p0yv5aGb2hbuYkjJohYlS/nbpLLUxcrm7+NegHCynMN7/YI+GCVlSelVLGkI8l9B8t6UkAa9Z fQQ= From: Julian Brown To: CC: , , Subject: [PATCH 7/8] OpenMP, Fortran: Split out OMP clause checking Date: Tue, 5 Sep 2023 12:28:27 -0700 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SCC_5_SHORT_WORD_LINES, SPF_HELO_PASS, 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 Sender: "Gcc-patches" This patch breaks out two helper functions from openmp.cc:resolve_omp_clauses, so those parts can be reused in order to improve diagnostics (duplicate clause checking, etc.) after "declare mapper" instantiation in the patch later in this series. This is pretty mechanical -- most previous lines are still executed in the same order, though there is a little harmless reshuffling in a couple of places to make things fit. There shouldn't be any behavioural changes introduced by this patch. 2023-09-05 Julian Brown gcc/fortran/ * openmp.cc (omp_verify_clauses_symbol_dups, omp_verify_map_motion_clauses): New helper functions, broken out of... (resolve_omp_clauses): Here. Call above. --- gcc/fortran/openmp.cc | 1229 +++++++++++++++++++++-------------------- 1 file changed, 629 insertions(+), 600 deletions(-) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 576b6784b441..1e0da61e9693 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -7314,6 +7314,631 @@ gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume) &el->expr->where); } +/* Check OMP_CLAUSES for duplicate symbols and various other constraints. + Helper function for resolve_omp_clauses. */ + +static void +omp_verify_clauses_symbol_dups (gfc_code *code, gfc_omp_clauses *omp_clauses, + gfc_namespace *ns, bool openacc) +{ + gfc_omp_namelist *n; + int list; + + /* Check that no symbol appears on multiple clauses, except that a symbol + can appear on both firstprivate and lastprivate. */ + for (list = 0; list < OMP_LIST_NUM; list++) + for (n = omp_clauses->lists[list]; n; n = n->next) + { + if (!n->sym) /* omp_all_memory. */ + continue; + n->sym->mark = 0; + n->sym->comp_mark = 0; + n->sym->data_mark = 0; + n->sym->dev_mark = 0; + n->sym->gen_mark = 0; + n->sym->reduc_mark = 0; + if (n->sym->attr.flavor == FL_VARIABLE + || n->sym->attr.proc_pointer + || (!code + && !ns->omp_udm_ns + && (!n->sym->attr.dummy || n->sym->ns != ns))) + { + if (!code + && !ns->omp_udm_ns + && (!n->sym->attr.dummy || n->sym->ns != ns)) + gfc_error ("Variable %qs is not a dummy argument at %L", + n->sym->name, &n->where); + continue; + } + if (n->sym->attr.flavor == FL_PROCEDURE + && n->sym->result == n->sym + && n->sym->attr.function) + { + if (gfc_current_ns->proc_name == n->sym + || (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name == n->sym)) + continue; + if (gfc_current_ns->proc_name->attr.entry_master) + { + gfc_entry_list *el = gfc_current_ns->entries; + for (; el; el = el->next) + if (el->sym == n->sym) + break; + if (el) + continue; + } + if (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name->attr.entry_master) + { + gfc_entry_list *el = gfc_current_ns->parent->entries; + for (; el; el = el->next) + if (el->sym == n->sym) + break; + if (el) + continue; + } + } + if (list == OMP_LIST_MAP + && n->sym->attr.flavor == FL_PARAMETER) + { + if (openacc) + gfc_error ("Object %qs is not a variable at %L; parameters" + " cannot be and need not be copied", n->sym->name, + &n->where); + else + gfc_error ("Object %qs is not a variable at %L; parameters" + " cannot be and need not be mapped", n->sym->name, + &n->where); + } + else if (list != OMP_LIST_USES_ALLOCATORS) + gfc_error ("Object %qs is not a variable at %L", n->sym->name, + &n->where); + } + if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN] + && code->op != EXEC_OMP_DO + && code->op != EXEC_OMP_SIMD + && code->op != EXEC_OMP_DO_SIMD + && code->op != EXEC_OMP_PARALLEL_DO + && code->op != EXEC_OMP_PARALLEL_DO_SIMD) + gfc_error ("% REDUCTION clause on construct other than DO, SIMD, " + "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L", + &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where); + + for (list = 0; list < OMP_LIST_NUM; list++) + if (list != OMP_LIST_FIRSTPRIVATE + && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALIGNED + && list != OMP_LIST_DEPEND + && list != OMP_LIST_FROM + && list != OMP_LIST_TO + && (list != OMP_LIST_REDUCTION || !openacc) + && list != OMP_LIST_ALLOCATE) + for (n = omp_clauses->lists[list]; n; n = n->next) + { + bool component_ref_p = false; + + /* Allow multiple components of the same (e.g. derived-type) + variable here. Duplicate components are detected elsewhere. */ + if (n->expr && n->expr->expr_type == EXPR_VARIABLE) + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + component_ref_p = true; + if ((list == OMP_LIST_IS_DEVICE_PTR + || list == OMP_LIST_HAS_DEVICE_ADDR) + && !component_ref_p) + { + if (n->sym->gen_mark + || n->sym->dev_mark + || n->sym->reduc_mark + || n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->dev_mark = 1; + } + else if ((list == OMP_LIST_USE_DEVICE_PTR + || list == OMP_LIST_USE_DEVICE_ADDR + || list == OMP_LIST_PRIVATE + || list == OMP_LIST_SHARED) + && !component_ref_p) + { + if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + n->sym->gen_mark = 1; + /* Set both generic and device bits if we have + use_device_*(x) or shared(x). This allows us to diagnose + "map(x) private(x)" below. */ + if (list != OMP_LIST_PRIVATE) + n->sym->dev_mark = 1; + } + } + else if ((list == OMP_LIST_REDUCTION + || list == OMP_LIST_REDUCTION_TASK + || list == OMP_LIST_REDUCTION_INSCAN + || list == OMP_LIST_IN_REDUCTION + || list == OMP_LIST_TASK_REDUCTION) + && !component_ref_p) + { + /* Attempts to mix reduction types are diagnosed below. */ + if (n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->reduc_mark = 1; + } + else if ((!component_ref_p && n->sym->comp_mark) + || (component_ref_p && n->sym->mark)) + { + if (openacc) + gfc_error ("Symbol %qs has mixed component and non-component " + "accesses at %L", n->sym->name, &n->where); + } + else if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + if (component_ref_p) + n->sym->comp_mark = 1; + else + n->sym->mark = 1; + } + } + + /* Detect specifically the case where we have "map(x) private(x)" and raise + an error. If we have "...simd" combined directives though, the "private" + applies to the simd part, so this is permitted. */ + for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) + if (n->sym->mark + && n->sym->gen_mark + && !n->sym->dev_mark + && !n->sym->reduc_mark + && code->op != EXEC_OMP_TARGET_SIMD + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) + gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->name, + &n->where); + + gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); + for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++) + { + gfc_omp_namelist **pn = &omp_clauses->lists[list]; + while ((n = *pn) != NULL) + { + bool remove = false; + + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + { + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; + } + else if (n->sym->mark + && code->op != EXEC_OMP_TARGET_TEAMS + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE + && code->op != EXEC_OMP_TARGET_TEAMS_LOOP + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL + && code->op != EXEC_OMP_TARGET_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && (code->op + != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD)) + { + gfc_error ("Symbol %qs present on both data and map clauses " + "at %L", n->sym->name, &n->where); + /* We've already shown an error. Avoid confusing gimplify. */ + remove = true; + } + + if (remove) + *pn = n->next; + else + pn = &n->next; + } + } + + for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) + { + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->data_mark = 1; + } + for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) + n->sym->data_mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) + { + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->data_mark = 1; + } + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + n->sym->mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + } + + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + { + if (n->u2.allocator + && (!gfc_resolve_expr (n->u2.allocator) + || n->u2.allocator->ts.type != BT_INTEGER + || n->u2.allocator->rank != 0 + || n->u2.allocator->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "% kind at %L", + &n->u2.allocator->where); + break; + } + if (!n->u.align) + continue; + HOST_WIDE_INT alignment = 0; + if (!gfc_resolve_expr (n->u.align) + || n->u.align->ts.type != BT_INTEGER + || n->u.align->rank != 0 + || n->u.align->expr_type != EXPR_CONSTANT + || gfc_extract_hwi (n->u.align, &alignment) + || alignment <= 0 + || !pow2p_hwi (alignment)) + { + gfc_error ("ALIGN requires a scalar positive constant integer " + "alignment expression at %L that is a power of two", + &n->u.align->where); + break; + } + } + + /* Check for 2 things here. + 1. There is no duplication of variable in allocate clause. + 2. Variable in allocate clause are also present in some + privatization clase (non-composite case). */ + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym) + n->sym->mark = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; ) + { + if (n->sym == NULL) + { + n = n->next; + continue; + } + if (n->sym->mark == 1) + { + gfc_warning (0, "%qs appears more than once in % " + "at %L" , n->sym->name, &n->where); + /* We have already seen this variable so it is a duplicate. + Remove it. */ + if (prev != NULL && prev->next == n) + { + prev->next = n->next; + n->next = NULL; + gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE); + n = prev->next; + } + continue; + } + n->sym->mark = 1; + prev = n; + n = n->next; + } + + /* Non-composite constructs. */ + if (code && code->op < EXEC_OMP_DO_SIMD) + { + for (list = 0; list < OMP_LIST_NUM; list++) + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: + case OMP_LIST_REDUCTION_TASK: + case OMP_LIST_IN_REDUCTION: + case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_LINEAR: + for (n = omp_clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->mark == 1) + gfc_error ("%qs specified in % clause at %L but not " + "in an explicit privatization clause", n->sym->name, + &n->where); + } + if (code + && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE) + && code->block + && code->block->next + && code->block->next->op == EXEC_ALLOCATE) + { + gfc_alloc *a; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + { + if (n->sym == NULL) + continue; + for (a = code->block->next->ext.alloc.list; a; a = a->next) + if (a->expr->expr_type == EXPR_VARIABLE + && a->expr->symtree->n.sym == n->sym) + break; + if (a == NULL) + gfc_error ("%qs specified in % at %L but not " + "in the associated ALLOCATE statement", + n->sym->name, &n->where); + } + } + } + + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + n->sym->mark = 0; + for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) + if (n->expr == NULL) + n->sym->mark = 1; + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + { + if (n->expr == NULL && n->sym->mark) + gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + } +} + +/* Check that the parameter of a MAP, TO and FROM clause N meets certain + constraints. Helper function for resolve_omp_clauses. */ + +static bool +omp_verify_map_motion_clauses (gfc_code *code, int list, const char *name, + gfc_omp_namelist *n, bool openacc) +{ + gfc_ref *lastref = NULL, *lastslice = NULL; + bool resolved = false; + if (n->expr) + { + lastref = n->expr->ref; + resolved = gfc_resolve_expr (n->expr); + + /* Look through component refs to find last array reference. */ + if (resolved) + { + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT + || ref->type == REF_SUBSTRING + || ref->type == REF_INQUIRY) + lastref = ref; + else if (ref->type == REF_ARRAY) + { + for (int i = 0; i < ref->u.ar.dimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_RANGE) + lastslice = ref; + + lastref = ref; + } + + /* The "!$acc cache" directive allows rectangular subarrays to be + specified, with some restrictions on the form of bounds (not + implemented). + Only raise an error here if we're really sure the array isn't + contiguous. An expression such as arr(-n:n,-n:n) could be + contiguous even if it looks like it may not be. Also OpenMP's + 'target update' permits strides for the to/from clause. */ + if (code + && code->op != EXEC_OACC_UPDATE + && code->op != EXEC_OMP_TARGET_UPDATE + && list != OMP_LIST_CACHE + && list != OMP_LIST_DEPEND + && !gfc_is_simply_contiguous (n->expr, false, true) + && gfc_is_not_contiguous (n->expr) + && !(lastslice && (lastslice->next + || lastslice->type != REF_ARRAY))) + gfc_error ("Array is not contiguous at %L", &n->where); + } + } + if (openacc + && list == OMP_LIST_MAP + && (n->u.map_op == OMP_MAP_ATTACH || n->u.map_op == OMP_MAP_DETACH)) + { + symbol_attribute attr; + if (n->expr) + attr = gfc_expr_attr (n->expr); + else + attr = n->sym->attr; + if (!attr.pointer && !attr.allocatable) + gfc_error ("%qs clause argument must be ALLOCATABLE or a POINTER " + "at %L", + (n->u.map_op == OMP_MAP_ATTACH) ? "attach" : "detach", + &n->where); + } + if (lastref + || (n->expr && (!resolved || n->expr->expr_type != EXPR_VARIABLE))) + { + if (!lastslice && lastref && lastref->type == REF_SUBSTRING) + gfc_error ("Unexpected substring reference in %s clause at %L", name, + &n->where); + else if (!lastslice && lastref && lastref->type == REF_INQUIRY) + { + gcc_assert (lastref->u.i == INQUIRY_RE + || lastref->u.i == INQUIRY_IM); + gfc_error ("Unexpected complex-parts designator reference in %s " + "clause at %L", name, &n->where); + } + else if (!resolved + || n->expr->expr_type != EXPR_VARIABLE + || (lastslice + && (lastslice->next || lastslice->type != REF_ARRAY))) + gfc_error ("%qs in %s clause at %L is not a proper array section", + n->sym->name, name, &n->where); + else if (lastslice) + { + int i; + gfc_array_ref *ar = &lastslice->u.ar; + for (i = 0; i < ar->dimen; i++) + if (ar->stride[i] && code && code->op != EXEC_OACC_UPDATE) + { + gfc_error ("Stride should not be specified for array section " + "in %s clause at %L", name, &n->where); + return false; + } + else if (ar->dimen_type[i] != DIMEN_ELEMENT + && ar->dimen_type[i] != DIMEN_RANGE) + { + gfc_error ("%qs in %s clause at %L is not a proper array " + "section", n->sym->name, name, &n->where); + return false; + } + else if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY) + && ar->start[i] + && ar->start[i]->expr_type == EXPR_CONSTANT + && ar->end[i] + && ar->end[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (ar->start[i]->value.integer, + ar->end[i]->value.integer) > 0) + { + gfc_error ("%qs in %s clause at %L is a zero size array " + "section", n->sym->name, + list == OMP_LIST_DEPEND ? "DEPEND" : "AFFINITY", + &n->where); + return false; + } + } + } + else if (openacc) + { + if (list == OMP_LIST_MAP && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR) + resolve_oacc_deviceptr_clause (n->sym, n->where, name); + else + resolve_oacc_data_clauses (n->sym, n->where, name); + } + else if (list != OMP_LIST_DEPEND + && n->sym->as + && n->sym->as->type == AS_ASSUMED_SIZE) + gfc_error ("Assumed size array %qs in %s clause at %L", + n->sym->name, name, &n->where); + if (!openacc + && list == OMP_LIST_MAP + && n->sym->ts.type == BT_DERIVED + && n->sym->ts.u.derived->attr.alloc_comp) + gfc_error ("List item %qs with allocatable components is not permitted " + "in map clause at %L", n->sym->name, &n->where); + + if (!code || list != OMP_LIST_MAP || openacc) + return true; + + switch (code->op) + { + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_PRESENT_TO: + case OMP_MAP_ALWAYS_PRESENT_TO: + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_ALWAYS_PRESENT_FROM: + case OMP_MAP_TOFROM: + case OMP_MAP_ALWAYS_TOFROM: + case OMP_MAP_PRESENT_TOFROM: + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + case OMP_MAP_ALLOC: + case OMP_MAP_PRESENT_ALLOC: + break; + default: + gfc_error ("TARGET%s with map-type other than TO, FROM, TOFROM, or " + "ALLOC on MAP clause at %L", + code->op == EXEC_OMP_TARGET ? "" : " DATA", &n->where); + break; + } + break; + case EXEC_OMP_TARGET_ENTER_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_PRESENT_TO: + case OMP_MAP_ALWAYS_PRESENT_TO: + case OMP_MAP_ALLOC: + case OMP_MAP_PRESENT_ALLOC: + break; + case OMP_MAP_TOFROM: + n->u.map_op = OMP_MAP_TO; + break; + case OMP_MAP_ALWAYS_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_TO; + break; + case OMP_MAP_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_PRESENT_TO; + break; + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_PRESENT_TO; + break; + default: + gfc_error ("TARGET ENTER DATA with map-type other than TO, TOFROM " + "or ALLOC on MAP clause at %L", &n->where); + break; + } + break; + case EXEC_OMP_TARGET_EXIT_DATA: + switch (n->u.map_op) + { + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_ALWAYS_PRESENT_FROM: + case OMP_MAP_RELEASE: + case OMP_MAP_DELETE: + break; + case OMP_MAP_TOFROM: + n->u.map_op = OMP_MAP_FROM; + break; + case OMP_MAP_ALWAYS_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_FROM; + break; + case OMP_MAP_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_PRESENT_FROM; + break; + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_PRESENT_FROM; + break; + default: + gfc_error ("TARGET EXIT DATA with map-type other than FROM, TOFROM, " + "RELEASE, or DELETE on MAP clause at %L", &n->where); + break; + } + break; + default: + ; + } + + return true; +} /* OpenMP directive resolving routines. */ @@ -7540,355 +8165,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer " "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where); - /* Check that no symbol appears on multiple clauses, except that - a symbol can appear on both firstprivate and lastprivate. */ - for (list = 0; list < OMP_LIST_NUM; list++) - for (n = omp_clauses->lists[list]; n; n = n->next) - { - if (!n->sym) /* omp_all_memory. */ - continue; - n->sym->mark = 0; - n->sym->comp_mark = 0; - n->sym->data_mark = 0; - n->sym->dev_mark = 0; - n->sym->gen_mark = 0; - n->sym->reduc_mark = 0; - if (n->sym->attr.flavor == FL_VARIABLE - || n->sym->attr.proc_pointer - || (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) - { - if (!code && (!n->sym->attr.dummy || n->sym->ns != ns)) - gfc_error ("Variable %qs is not a dummy argument at %L", - n->sym->name, &n->where); - continue; - } - if (n->sym->attr.flavor == FL_PROCEDURE - && n->sym->result == n->sym - && n->sym->attr.function) - { - if (gfc_current_ns->proc_name == n->sym - || (gfc_current_ns->parent - && gfc_current_ns->parent->proc_name == n->sym)) - continue; - if (gfc_current_ns->proc_name->attr.entry_master) - { - gfc_entry_list *el = gfc_current_ns->entries; - for (; el; el = el->next) - if (el->sym == n->sym) - break; - if (el) - continue; - } - if (gfc_current_ns->parent - && gfc_current_ns->parent->proc_name->attr.entry_master) - { - gfc_entry_list *el = gfc_current_ns->parent->entries; - for (; el; el = el->next) - if (el->sym == n->sym) - break; - if (el) - continue; - } - } - if (list == OMP_LIST_MAP - && n->sym->attr.flavor == FL_PARAMETER) - { - if (openacc) - gfc_error ("Object %qs is not a variable at %L; parameters" - " cannot be and need not be copied", n->sym->name, - &n->where); - else - gfc_error ("Object %qs is not a variable at %L; parameters" - " cannot be and need not be mapped", n->sym->name, - &n->where); - } - else if (list != OMP_LIST_USES_ALLOCATORS) - gfc_error ("Object %qs is not a variable at %L", n->sym->name, - &n->where); - } - if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN] - && code->op != EXEC_OMP_DO - && code->op != EXEC_OMP_SIMD - && code->op != EXEC_OMP_DO_SIMD - && code->op != EXEC_OMP_PARALLEL_DO - && code->op != EXEC_OMP_PARALLEL_DO_SIMD) - gfc_error ("% REDUCTION clause on construct other than DO, SIMD, " - "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L", - &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where); - - for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_FIRSTPRIVATE - && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_ALIGNED - && list != OMP_LIST_DEPEND - && list != OMP_LIST_FROM - && list != OMP_LIST_TO - && (list != OMP_LIST_REDUCTION || !openacc) - && list != OMP_LIST_ALLOCATE) - for (n = omp_clauses->lists[list]; n; n = n->next) - { - bool component_ref_p = false; - - /* Allow multiple components of the same (e.g. derived-type) - variable here. Duplicate components are detected elsewhere. */ - if (n->expr && n->expr->expr_type == EXPR_VARIABLE) - for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT) - component_ref_p = true; - if ((list == OMP_LIST_IS_DEVICE_PTR - || list == OMP_LIST_HAS_DEVICE_ADDR) - && !component_ref_p) - { - if (n->sym->gen_mark - || n->sym->dev_mark - || n->sym->reduc_mark - || n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->dev_mark = 1; - } - else if ((list == OMP_LIST_USE_DEVICE_PTR - || list == OMP_LIST_USE_DEVICE_ADDR - || list == OMP_LIST_PRIVATE - || list == OMP_LIST_SHARED) - && !component_ref_p) - { - if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - { - n->sym->gen_mark = 1; - /* Set both generic and device bits if we have - use_device_*(x) or shared(x). This allows us to diagnose - "map(x) private(x)" below. */ - if (list != OMP_LIST_PRIVATE) - n->sym->dev_mark = 1; - } - } - else if ((list == OMP_LIST_REDUCTION - || list == OMP_LIST_REDUCTION_TASK - || list == OMP_LIST_REDUCTION_INSCAN - || list == OMP_LIST_IN_REDUCTION - || list == OMP_LIST_TASK_REDUCTION) - && !component_ref_p) - { - /* Attempts to mix reduction types are diagnosed below. */ - if (n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - n->sym->reduc_mark = 1; - } - else if ((!component_ref_p && n->sym->comp_mark) - || (component_ref_p && n->sym->mark)) - { - if (openacc) - gfc_error ("Symbol %qs has mixed component and non-component " - "accesses at %L", n->sym->name, &n->where); - } - else if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - { - if (component_ref_p) - n->sym->comp_mark = 1; - else - n->sym->mark = 1; - } - } - - /* Detect specifically the case where we have "map(x) private(x)" and raise - an error. If we have "...simd" combined directives though, the "private" - applies to the simd part, so this is permitted though. */ - for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) - if (n->sym->mark - && n->sym->gen_mark - && !n->sym->dev_mark - && !n->sym->reduc_mark - && code->op != EXEC_OMP_TARGET_SIMD - && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - - gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); - for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++) - for (n = omp_clauses->lists[list]; n; n = n->next) - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - { - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; - } - else if (n->sym->mark - && code->op != EXEC_OMP_TARGET_TEAMS - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE - && code->op != EXEC_OMP_TARGET_TEAMS_LOOP - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO - && code->op != EXEC_OMP_TARGET_PARALLEL - && code->op != EXEC_OMP_TARGET_PARALLEL_DO - && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP - && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) - gfc_error ("Symbol %qs present on both data and map clauses " - "at %L", n->sym->name, &n->where); - - for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) - { - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->data_mark = 1; - } - for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - n->sym->data_mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - { - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->data_mark = 1; - } - - for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) - n->sym->mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) - { - if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - } - - if (omp_clauses->lists[OMP_LIST_ALLOCATE]) - { - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - { - if (n->u2.allocator - && (!gfc_resolve_expr (n->u2.allocator) - || n->u2.allocator->ts.type != BT_INTEGER - || n->u2.allocator->rank != 0 - || n->u2.allocator->ts.kind != gfc_c_intptr_kind)) - { - gfc_error ("Expected integer expression of the " - "% kind at %L", - &n->u2.allocator->where); - break; - } - if (!n->u.align) - continue; - HOST_WIDE_INT alignment = 0; - if (!gfc_resolve_expr (n->u.align) - || n->u.align->ts.type != BT_INTEGER - || n->u.align->rank != 0 - || n->u.align->expr_type != EXPR_CONSTANT - || gfc_extract_hwi (n->u.align, &alignment) - || alignment <= 0 - || !pow2p_hwi (alignment)) - { - gfc_error ("ALIGN requires a scalar positive constant integer " - "alignment expression at %L that is a power of two", - &n->u.align->where); - break; - } - } - - /* Check for 2 things here. - 1. There is no duplication of variable in allocate clause. - 2. Variable in allocate clause are also present in some - privatization clase (non-composite case). */ - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - if (n->sym) - n->sym->mark = 0; - - gfc_omp_namelist *prev = NULL; - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; ) - { - if (n->sym == NULL) - { - n = n->next; - continue; - } - if (n->sym->mark == 1) - { - gfc_warning (0, "%qs appears more than once in % " - "at %L" , n->sym->name, &n->where); - /* We have already seen this variable so it is a duplicate. - Remove it. */ - if (prev != NULL && prev->next == n) - { - prev->next = n->next; - n->next = NULL; - gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE); - n = prev->next; - } - continue; - } - n->sym->mark = 1; - prev = n; - n = n->next; - } - - /* Non-composite constructs. */ - if (code && code->op < EXEC_OMP_DO_SIMD) - { - for (list = 0; list < OMP_LIST_NUM; list++) - switch (list) - { - case OMP_LIST_PRIVATE: - case OMP_LIST_FIRSTPRIVATE: - case OMP_LIST_LASTPRIVATE: - case OMP_LIST_REDUCTION: - case OMP_LIST_REDUCTION_INSCAN: - case OMP_LIST_REDUCTION_TASK: - case OMP_LIST_IN_REDUCTION: - case OMP_LIST_TASK_REDUCTION: - case OMP_LIST_LINEAR: - for (n = omp_clauses->lists[list]; n; n = n->next) - n->sym->mark = 0; - break; - default: - break; - } - - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - if (n->sym->mark == 1) - gfc_error ("%qs specified in % clause at %L but not " - "in an explicit privatization clause", - n->sym->name, &n->where); - } - if (code - && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE) - && code->block - && code->block->next - && code->block->next->op == EXEC_ALLOCATE) - { - gfc_alloc *a; - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - { - if (n->sym == NULL) - continue; - for (a = code->block->next->ext.alloc.list; a; a = a->next) - if (a->expr->expr_type == EXPR_VARIABLE - && a->expr->symtree->n.sym == n->sym) - break; - if (a == NULL) - gfc_error ("%qs specified in % at %L but not " - "in the associated ALLOCATE statement", - n->sym->name, &n->where); - } - } - - } + omp_verify_clauses_symbol_dups (code, omp_clauses, ns, openacc); /* OpenACC reductions. */ if (openacc) @@ -7911,20 +8188,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } - for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) - n->sym->mark = 0; - for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) - if (n->expr == NULL) - n->sym->mark = 1; - for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) - { - if (n->expr == NULL && n->sym->mark) - gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - } - bool has_inscan = false, has_notinscan = false; for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) @@ -8093,243 +8356,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "type shall be a scalar integer of " "OMP_DEPEND_KIND kind", &n->expr->where); } - gfc_ref *lastref = NULL, *lastslice = NULL; - bool resolved = false; - if (n->expr) - { - lastref = n->expr->ref; - resolved = gfc_resolve_expr (n->expr); - - /* Look through component refs to find last array - reference. */ - if (resolved) - { - for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT - || ref->type == REF_SUBSTRING - || ref->type == REF_INQUIRY) - lastref = ref; - else if (ref->type == REF_ARRAY) - { - for (int i = 0; i < ref->u.ar.dimen; i++) - if (ref->u.ar.dimen_type[i] == DIMEN_RANGE) - lastslice = ref; - - lastref = ref; - } - - /* The "!$acc cache" directive allows rectangular - subarrays to be specified, with some restrictions - on the form of bounds (not implemented). - Only raise an error here if we're really sure the - array isn't contiguous. An expression such as - arr(-n:n,-n:n) could be contiguous even if it looks - like it may not be. */ - if (code->op != EXEC_OACC_UPDATE - && list != OMP_LIST_CACHE - && list != OMP_LIST_DEPEND - && !gfc_is_simply_contiguous (n->expr, false, true) - && gfc_is_not_contiguous (n->expr) - && !(lastslice - && (lastslice->next - || lastslice->type != REF_ARRAY))) - gfc_error ("Array is not contiguous at %L", - &n->where); - } - } - if (openacc - && list == OMP_LIST_MAP - && (n->u.map_op == OMP_MAP_ATTACH - || n->u.map_op == OMP_MAP_DETACH)) - { - symbol_attribute attr; - if (n->expr) - attr = gfc_expr_attr (n->expr); - else - attr = n->sym->attr; - if (!attr.pointer && !attr.allocatable) - gfc_error ("%qs clause argument must be ALLOCATABLE or " - "a POINTER at %L", - (n->u.map_op == OMP_MAP_ATTACH) ? "attach" - : "detach", &n->where); - } - if (lastref - || (n->expr - && (!resolved || n->expr->expr_type != EXPR_VARIABLE))) - { - if (!lastslice - && lastref - && lastref->type == REF_SUBSTRING) - gfc_error ("Unexpected substring reference in %s clause " - "at %L", name, &n->where); - else if (!lastslice - && lastref - && lastref->type == REF_INQUIRY) - { - gcc_assert (lastref->u.i == INQUIRY_RE - || lastref->u.i == INQUIRY_IM); - gfc_error ("Unexpected complex-parts designator " - "reference in %s clause at %L", - name, &n->where); - } - else if (!resolved - || n->expr->expr_type != EXPR_VARIABLE - || (lastslice - && (lastslice->next - || lastslice->type != REF_ARRAY))) - gfc_error ("%qs in %s clause at %L is not a proper " - "array section", n->sym->name, name, - &n->where); - else if (lastslice) - { - int i; - gfc_array_ref *ar = &lastslice->u.ar; - for (i = 0; i < ar->dimen; i++) - if (ar->stride[i] && code->op != EXEC_OACC_UPDATE) - { - gfc_error ("Stride should not be specified for " - "array section in %s clause at %L", - name, &n->where); - break; - } - else if (ar->dimen_type[i] != DIMEN_ELEMENT - && ar->dimen_type[i] != DIMEN_RANGE) - { - gfc_error ("%qs in %s clause at %L is not a " - "proper array section", - n->sym->name, name, &n->where); - break; - } - else if ((list == OMP_LIST_DEPEND - || list == OMP_LIST_AFFINITY) - && ar->start[i] - && ar->start[i]->expr_type == EXPR_CONSTANT - && ar->end[i] - && ar->end[i]->expr_type == EXPR_CONSTANT - && mpz_cmp (ar->start[i]->value.integer, - ar->end[i]->value.integer) > 0) - { - gfc_error ("%qs in %s clause at %L is a " - "zero size array section", - n->sym->name, - list == OMP_LIST_DEPEND - ? "DEPEND" : "AFFINITY", &n->where); - break; - } - } - } - else if (openacc) - { - if (list == OMP_LIST_MAP - && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR) - resolve_oacc_deviceptr_clause (n->sym, n->where, name); - else - resolve_oacc_data_clauses (n->sym, n->where, name); - } - else if (list != OMP_LIST_DEPEND - && n->sym->as - && n->sym->as->type == AS_ASSUMED_SIZE) - gfc_error ("Assumed size array %qs in %s clause at %L", - n->sym->name, name, &n->where); - if (!openacc - && list == OMP_LIST_MAP - && n->sym->ts.type == BT_DERIVED - && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("List item %qs with allocatable components is not " - "permitted in map clause at %L", n->sym->name, - &n->where); - if (list == OMP_LIST_MAP && !openacc) - switch (code->op) - { - case EXEC_OMP_TARGET: - case EXEC_OMP_TARGET_DATA: - switch (n->u.map_op) - { - case OMP_MAP_TO: - case OMP_MAP_ALWAYS_TO: - case OMP_MAP_PRESENT_TO: - case OMP_MAP_ALWAYS_PRESENT_TO: - case OMP_MAP_FROM: - case OMP_MAP_ALWAYS_FROM: - case OMP_MAP_PRESENT_FROM: - case OMP_MAP_ALWAYS_PRESENT_FROM: - case OMP_MAP_TOFROM: - case OMP_MAP_ALWAYS_TOFROM: - case OMP_MAP_PRESENT_TOFROM: - case OMP_MAP_ALWAYS_PRESENT_TOFROM: - case OMP_MAP_ALLOC: - case OMP_MAP_PRESENT_ALLOC: - break; - default: - gfc_error ("TARGET%s with map-type other than TO, " - "FROM, TOFROM, or ALLOC on MAP clause " - "at %L", - code->op == EXEC_OMP_TARGET - ? "" : " DATA", &n->where); - break; - } - break; - case EXEC_OMP_TARGET_ENTER_DATA: - switch (n->u.map_op) - { - case OMP_MAP_TO: - case OMP_MAP_ALWAYS_TO: - case OMP_MAP_PRESENT_TO: - case OMP_MAP_ALWAYS_PRESENT_TO: - case OMP_MAP_ALLOC: - case OMP_MAP_PRESENT_ALLOC: - break; - case OMP_MAP_TOFROM: - n->u.map_op = OMP_MAP_TO; - break; - case OMP_MAP_ALWAYS_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_TO; - break; - case OMP_MAP_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_PRESENT_TO; - break; - case OMP_MAP_ALWAYS_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_PRESENT_TO; - break; - default: - gfc_error ("TARGET ENTER DATA with map-type other " - "than TO, TOFROM or ALLOC on MAP clause " - "at %L", &n->where); - break; - } - break; - case EXEC_OMP_TARGET_EXIT_DATA: - switch (n->u.map_op) - { - case OMP_MAP_FROM: - case OMP_MAP_ALWAYS_FROM: - case OMP_MAP_PRESENT_FROM: - case OMP_MAP_ALWAYS_PRESENT_FROM: - case OMP_MAP_RELEASE: - case OMP_MAP_DELETE: - break; - case OMP_MAP_TOFROM: - n->u.map_op = OMP_MAP_FROM; - break; - case OMP_MAP_ALWAYS_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_FROM; - break; - case OMP_MAP_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_PRESENT_FROM; - break; - case OMP_MAP_ALWAYS_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_PRESENT_FROM; - break; - default: - gfc_error ("TARGET EXIT DATA with map-type other " - "than FROM, TOFROM, RELEASE, or DELETE on " - "MAP clause at %L", &n->where); - break; - } - break; - default: - break; - } + if (!omp_verify_map_motion_clauses (code, list, name, n, + openacc)) + break; } if (list != OMP_LIST_DEPEND) From patchwork Tue Sep 5 19:28:28 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830104 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=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 (ip-8-43-85-97.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 4RgFxb70dwz1ygx for ; Wed, 6 Sep 2023 05:31:47 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 04CAC38A8171 for ; Tue, 5 Sep 2023 19:31:46 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 0E28D3851ABC; Tue, 5 Sep 2023 19:30:24 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0E28D3851ABC 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="6.02,229,1688457600"; d="scan'208";a="16179220" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:30:23 -0800 IronPort-SDR: zpD0r79VNWKp+ZoPGUApja1hBrnU7cSKDO181HLjbDRvxSPoqNOoEJYUV1QvnaVewQcGcDV+LC E+M1xtRJ6AagJ+6Rhpo1IrG7I3vj9rzVkPBVaECVue0lpq6gAG+Zr43oNvcG3eivHYU/aCcdJ+ uuVuy6tgnLtYWa3USAUn0W3FXbpqFC0Ib+ifcz0KOobUC5178jjfZBfvMyK7ac+Xt91ltHuFE1 VAmiWaCIC4X/HIFZS0fPVx39pZff3/H/uWIiXyf4y2qC122A3hdVQEn0VlN9Zyi/HGaDo3iPxZ GGU= From: Julian Brown To: CC: , , Subject: [PATCH 8/8] OpenMP: Fortran "!$omp declare mapper" support Date: Tue, 5 Sep 2023 12:28:28 -0700 Message-ID: <2aaa9204cded930d85531c3e2a32a6c07cf6d545.1693941293.git.julian@codesourcery.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP, URIBL_BLACK 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 Sender: "Gcc-patches" This patch implements "omp declare mapper" functionality for Fortran, following the equivalent support for C and C++. This version of the patch is based on the version posted for the og13 branch: https://gcc.gnu.org/pipermail/gcc-patches/2023-June/623357.html and contains some significant changes from the version last posted for mainline, here: https://gcc.gnu.org/pipermail/gcc-patches/2022-December/609042.html In particular, mappers are resolved during resolution in the Fortran FE, rather than directly at parse time, and there are improvements to diagnostics. Each of 'target', 'target data', 'target enter data', and 'target exit data' directives are supported for mappers. The following patches from the og13 branch have also been incorporated into this one: "OpenMP: Reprocess expanded clauses after 'declare mapper' instantiation": https://gcc.gnu.org/pipermail/gcc-patches/2023-August/627006.html "OpenMP: Look up 'declare mapper' definitions at resolution time not parse time": https://gcc.gnu.org/pipermail/gcc-patches/2023-August/627007.html 2023-09-05 Julian Brown gcc/fortran/ * dump-parse-tree.cc (show_attr): Show omp_udm_artificial_var flag. (show_omp_namelist): Support OMP_MAP_POINTER_ONLY and OMP_MAP_UNSET. * f95-lang.cc (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE, LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define language hooks. * gfortran.h (gfc_statement): Add ST_OMP_DECLARE_MAPPER. (symbol_attribute): Add omp_udm_artificial_var attribute. (gfc_omp_map_op): Add OMP_MAP_POINTER_ONLY and OMP_MAP_UNSET. (gfc_omp_namelist): Add udm pointer to u2 union. (gfc_omp_clauses): Add gfc_namespace pointer field 'ns'. (gfc_omp_udm): New struct. (gfc_omp_namelist_udm): New struct. (gfc_symtree): Add omp_udm pointer. (gfc_namespace): Add omp_udm_root symtree. Add omp_udm_ns flag. (toc_directive): Add TOC_OPENMP_DECLARE_MAPPER value. (gfc_free_omp_udm, gfc_omp_udm_find, gfc_find_omp_udm, gfc_resolve_omp_udms, gfc_omp_instantiate_mappers): Add prototypes. * match.cc (gfc_free_omp_namelist): Add support for freeing user-defined 'declare mapper' definitions safely. * match.h (gfc_match_omp_declare_mapper): Add prototype. * module.cc (ab_attribute): Add AB_OMP_DECLARE_MAPPER_VAR. (attr_bits): Add OMP_DECLARE_MAPPER_VAR. (mio_symbol_attribute): Read/write AB_OMP_DECLARE_MAPPER_VAR attribute. Set referenced attr on read. (omp_map_clause_ops, omp_map_cardinality): New arrays. (load_omp_udms, check_omp_declare_mappers): New functions. (read_module): Load and check OMP declare mappers. (write_omp_udm, write_omp_udms): New functions. (write_module): Write OMP declare mappers. * openmp.cc (gfc_match_omp_clauses): Add DEFAULT_MAP_OP parameter. Add declare mapper support. (gfc_free_omp_udm, gfc_find_omp_udm, gfc_omp_udm_find, gfc_match_omp_declare_mapper): New functions. (omp_verify_clauses_symbol_dups, omp_verify_map_motion_clauses): Update function comments. (resolve_omp_clauses): Record namespace for 'declare mapper' definitions. Resolve mappers. (resolve_omp_mapper_clauses): New function. (resolve_omp_directive): Pass namespace to resolve_omp_clauses. (omp_split_map_op, omp_join_map_op, omp_map_decayed_kind, omp_basic_map_kind_name): New functions. (gfc_subst_replace, gfc_subst_prepend_ref): New static globals. (gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var, gfc_omp_instantiate_mapper, gfc_omp_instantiate_mappers, gfc_resolve_omp_udm, gfc_resolve_omp_udms): New functions. * parse.cc (decode_omp_directive): Add declare mapper support. (case_omp_decl): Add ST_OMP_DECLARE_MAPPER case. (gfc_ascii_statement): Add ST_OMP_DECLARE_MAPPER case. * resolve.cc (resolve_types): Call gfc_resolve_omp_udms. * symbol.cc (free_omp_udm_tree): New function. (gfc_free_namespace): Call above. * trans-decl.cc (omp_declare_mapper_ns): New global. (gfc_finish_var_decl, gfc_generate_function_code): Support declare mappers. (gfc_trans_deferred_vars): Ignore artificial declare-mapper vars. * trans-openmp.cc (tree-iterator.h): Include. (gfc_omp_finish_mapper_clauses, gfc_omp_extract_mapper_directive, gfc_omp_map_array_section): New functions. (gfc_trans_omp_clauses): Add declare mapper support and OMP_MAP_POINTER_ONLY support. (gfc_record_mapper_bindings_code_fn, gfc_record_mapper_bindings_expr_fn, gfc_find_nested_mappers, gfc_record_mapper_bindings): New functions. (gfc_typespec * hash traits): New template. (omp_declare_mapper_ns): Extern declaration. (gfc_trans_omp_target): Call gfc_omp_instantiate_mappers and gfc_record_mapper_bindings. (gfc_trans_omp_target_data, gfc_trans_omp_target_enter_data, gfc_trans_omp_target_exit_data): Call gfc_omp_instantiate_mappers. (gfc_trans_omp_mapper_name, gfc_trans_omp_declare_mapper, gfc_trans_omp_declare_mappers): New functions. * trans-stmt.h (gfc_trans_omp_declare_mappers): Add prototype. * trans.h (gfc_omp_finish_mapper_clauses, gfc_omp_extract_mapper_directive, gfc_omp_map_array_section): Add prototypes. gcc/ * gimplify.cc (dwarf2out.h): Include. (omp_maybe_get_descriptor_from_ptr): New function. (build_omp_struct_comp_nodes): Use above function to locate array descriptor when necessary. (omp_mapping_group_data, omp_mapping_group_ptr, omp_mapping_group_pset): New functions. (omp_instantiate_mapper): Handle inlining of "declare mapper" function bodies containing setup code (e.g. for Fortran). Handle pointers to derived types. Handle GOMP_MAP_MAPPING_GROUPs. * tree-pretty-print.cc (dump_omp_clause): Handle GOMP_MAP_MAPPING_GROUP. include/ * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_MAPPING_GROUP. gcc/testsuite/ * gfortran.dg/gomp/declare-mapper-1.f90: New test. * gfortran.dg/gomp/declare-mapper-5.f90: New test. * gfortran.dg/gomp/declare-mapper-14.f90: New test. * gfortran.dg/gomp/declare-mapper-22.f90: New test. * gfortran.dg/gomp/declare-mapper-22-p.f90: New test. * gfortran.dg/gomp/declare-mapper-23.f90: New test. * gfortran.dg/gomp/declare-mapper-26.f90: New test. * gfortran.dg/gomp/declare-mapper-26-p.f90: New test. * gfortran.dg/gomp/declare-mapper-29.f90: New test. * gfortran.dg/gomp/declare-mapper-31.f90: New test. * gfortran.dg/gomp/declare-mapper-31-p.f90: New test. libgomp/ * testsuite/libgomp.fortran/declare-mapper-2.f90: New test. * testsuite/libgomp.fortran/declare-mapper-3.f90: New test. * testsuite/libgomp.fortran/declare-mapper-4.f90: New test. * testsuite/libgomp.fortran/declare-mapper-4-p.f90: New test. * testsuite/libgomp.fortran/declare-mapper-6.f90: New test. * testsuite/libgomp.fortran/declare-mapper-7.f90: New test. * testsuite/libgomp.fortran/declare-mapper-8.f90: New test. * testsuite/libgomp.fortran/declare-mapper-9.f90: New test. * testsuite/libgomp.fortran/declare-mapper-10.f90: New test. * testsuite/libgomp.fortran/declare-mapper-11.f90: New test. * testsuite/libgomp.fortran/declare-mapper-12.f90: New test. * testsuite/libgomp.fortran/declare-mapper-13.f90: New test. * testsuite/libgomp.fortran/declare-mapper-15.f90: New test. * testsuite/libgomp.fortran/declare-mapper-17.f90: New test. * testsuite/libgomp.fortran/declare-mapper-18.f90: New test. * testsuite/libgomp.fortran/declare-mapper-19.f90: New test. * testsuite/libgomp.fortran/declare-mapper-20.f90: New test. * testsuite/libgomp.fortran/declare-mapper-21.f90: New test. * testsuite/libgomp.fortran/declare-mapper-21-p.f90: New test. * testsuite/libgomp.fortran/declare-mapper-30.f90: New test. * testsuite/libgomp.fortran/declare-mapper-30-p.f90: New test. --- gcc/fortran/dump-parse-tree.cc | 4 + gcc/fortran/f95-lang.cc | 7 + gcc/fortran/gfortran.h | 63 +- gcc/fortran/match.cc | 7 +- gcc/fortran/match.h | 1 + gcc/fortran/module.cc | 257 +++++- gcc/fortran/openmp.cc | 786 +++++++++++++++++- gcc/fortran/parse.cc | 10 +- gcc/fortran/resolve.cc | 2 + gcc/fortran/symbol.cc | 16 + gcc/fortran/trans-decl.cc | 33 +- gcc/fortran/trans-openmp.cc | 515 +++++++++++- gcc/fortran/trans-stmt.h | 1 + gcc/fortran/trans.h | 3 + gcc/gimplify.cc | 298 ++++++- .../gfortran.dg/gomp/declare-mapper-1.f90 | 71 ++ .../gfortran.dg/gomp/declare-mapper-14.f90 | 26 + .../gfortran.dg/gomp/declare-mapper-22-p.f90 | 61 ++ .../gfortran.dg/gomp/declare-mapper-22.f90 | 63 ++ .../gfortran.dg/gomp/declare-mapper-23.f90 | 25 + .../gfortran.dg/gomp/declare-mapper-26-p.f90 | 29 + .../gfortran.dg/gomp/declare-mapper-26.f90 | 34 + .../gfortran.dg/gomp/declare-mapper-29.f90 | 22 + .../gfortran.dg/gomp/declare-mapper-31-p.f90 | 35 + .../gfortran.dg/gomp/declare-mapper-31.f90 | 36 + .../gfortran.dg/gomp/declare-mapper-5.f90 | 45 + gcc/tree-pretty-print.cc | 3 + include/gomp-constants.h | 5 +- .../libgomp.fortran/declare-mapper-10.f90 | 40 + .../libgomp.fortran/declare-mapper-11.f90 | 38 + .../libgomp.fortran/declare-mapper-12.f90 | 33 + .../libgomp.fortran/declare-mapper-13.f90 | 49 ++ .../libgomp.fortran/declare-mapper-15.f90 | 24 + .../libgomp.fortran/declare-mapper-17.f90 | 92 ++ .../libgomp.fortran/declare-mapper-18.f90 | 46 + .../libgomp.fortran/declare-mapper-19.f90 | 29 + .../libgomp.fortran/declare-mapper-2.f90 | 32 + .../libgomp.fortran/declare-mapper-20.f90 | 29 + .../libgomp.fortran/declare-mapper-21-p.f90 | 25 + .../libgomp.fortran/declare-mapper-21.f90 | 26 + .../libgomp.fortran/declare-mapper-3.f90 | 33 + .../libgomp.fortran/declare-mapper-30-p.f90 | 25 + .../libgomp.fortran/declare-mapper-30.f90 | 27 + .../libgomp.fortran/declare-mapper-4-p.f90 | 41 + .../libgomp.fortran/declare-mapper-4.f90 | 45 + .../libgomp.fortran/declare-mapper-6.f90 | 28 + .../libgomp.fortran/declare-mapper-7.f90 | 29 + .../libgomp.fortran/declare-mapper-8.f90 | 115 +++ .../libgomp.fortran/declare-mapper-9.f90 | 27 + 49 files changed, 3251 insertions(+), 40 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-22-p.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-26-p.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-31-p.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-21-p.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-30-p.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-4-p.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 68122e3e6fdc..0771ebbf5c7d 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -910,6 +910,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" PDT-STRING", dumpfile); if (attr->omp_udr_artificial_var) fputs (" OMP-UDR-ARTIFICIAL-VAR", dumpfile); + if (attr->omp_udm_artificial_var) + fputs (" OMP-UDM-ARTIFICIAL-VAR", dumpfile); if (attr->omp_declare_target) fputs (" OMP-DECLARE-TARGET", dumpfile); if (attr->omp_declare_target_link) @@ -1487,6 +1489,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) fputs ("always,present,tofrom:", dumpfile); break; case OMP_MAP_DELETE: fputs ("delete:", dumpfile); break; case OMP_MAP_RELEASE: fputs ("release:", dumpfile); break; + case OMP_MAP_POINTER_ONLY: fputs ("pointeronly:", dumpfile); break; + case OMP_MAP_UNSET: fputs ("unset:", dumpfile); break; default: break; } else if (list_type == OMP_LIST_LINEAR && n->u.linear.old_modifier) diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 350e6e379eb7..cbec180844fb 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -136,6 +136,9 @@ gfc_get_sarif_source_language (const char *) #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR #undef LANG_HOOKS_OMP_CLAUSE_DTOR #undef LANG_HOOKS_OMP_FINISH_CLAUSE +#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES +#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE +#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION #undef LANG_HOOKS_OMP_ALLOCATABLE_P #undef LANG_HOOKS_OMP_SCALAR_TARGET_P #undef LANG_HOOKS_OMP_SCALAR_P @@ -176,6 +179,10 @@ gfc_get_sarif_source_language (const char *) #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor #define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause +#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES gfc_omp_finish_mapper_clauses +#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \ + gfc_omp_extract_mapper_directive +#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION gfc_omp_map_array_section #define LANG_HOOKS_OMP_ALLOCATABLE_P gfc_omp_allocatable_p #define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p #define LANG_HOOKS_OMP_SCALAR_TARGET_P gfc_omp_scalar_target_p diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3070b4675e8e..3694c03673b0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -272,8 +272,9 @@ enum gfc_statement ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD, - ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION, - ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA, + ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_MAPPER, + ST_OMP_DECLARE_REDUCTION, ST_OMP_TARGET, ST_OMP_END_TARGET, + ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA, ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, ST_OMP_DECLARE_VARIANT, ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE, ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD, @@ -996,6 +997,10 @@ typedef struct !$OMP DECLARE REDUCTION. */ unsigned omp_udr_artificial_var:1; + /* This is a placeholder variable used in an !$OMP DECLARE MAPPER + directive. */ + unsigned omp_udm_artificial_var:1; + /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; @@ -1315,7 +1320,9 @@ enum gfc_omp_map_op OMP_MAP_PRESENT_TOFROM, OMP_MAP_ALWAYS_PRESENT_TO, OMP_MAP_ALWAYS_PRESENT_FROM, - OMP_MAP_ALWAYS_PRESENT_TOFROM + OMP_MAP_ALWAYS_PRESENT_TOFROM, + OMP_MAP_POINTER_ONLY, + OMP_MAP_UNSET }; enum gfc_omp_defaultmap @@ -1375,6 +1382,7 @@ typedef struct gfc_omp_namelist union { struct gfc_omp_namelist_udr *udr; + struct gfc_omp_namelist_udm *udm; gfc_namespace *ns; gfc_expr *allocator; struct gfc_symbol *traits_sym; @@ -1565,6 +1573,7 @@ typedef struct gfc_omp_clauses struct gfc_expr *message; struct gfc_omp_assumptions *assume; const char *critical_name; + gfc_namespace *ns; enum gfc_omp_default_sharing default_sharing; enum gfc_omp_atomic_op atomic_op; enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM]; @@ -1735,6 +1744,38 @@ typedef struct gfc_omp_namelist_udr gfc_omp_namelist_udr; #define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr) + +typedef struct gfc_omp_udm +{ + struct gfc_omp_udm *next; + locus where; /* Where the !$omp declare mapper construct occurred. */ + + const char *mapper_id; + gfc_typespec ts; + + struct gfc_symbol *var_sym; + struct gfc_namespace *mapper_ns; + + /* We probably don't need a whole gfc_omp_clauses here. We only use the + OMP_LIST_MAP clause list. */ + gfc_omp_clauses *clauses; + + tree backend_decl; +} +gfc_omp_udm; +#define gfc_get_omp_udm() XCNEW (gfc_omp_udm) + +typedef struct gfc_omp_namelist_udm +{ + /* Used to store mapper_id before resolution. */ + const char *mapper_id; + + bool multiple_elems_p; + struct gfc_omp_udm *udm; +} +gfc_omp_namelist_udm; +#define gfc_get_omp_namelist_udm() XCNEW (gfc_omp_namelist_udm) + /* The gfc_st_label structure is a BBT attached to a namespace that records the usage of statement labels within that space. */ @@ -2066,6 +2107,7 @@ typedef struct gfc_symtree gfc_common_head *common; gfc_typebound_proc *tb; gfc_omp_udr *omp_udr; + gfc_omp_udm *omp_udm; } n; } @@ -2109,6 +2151,8 @@ typedef struct gfc_namespace gfc_symtree *common_root; /* Tree containing all the OpenMP user defined reductions. */ gfc_symtree *omp_udr_root; + /* Tree containing all the OpenMP user defined mappers. */ + gfc_symtree *omp_udm_root; /* Tree containing type-bound procedures. */ gfc_symtree *tb_sym_root; @@ -2228,6 +2272,9 @@ typedef struct gfc_namespace /* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */ unsigned omp_udr_ns:1; + /* Set to 1 for !$OMP DECLARE MAPPER namespaces. */ + unsigned omp_udm_ns:1; + /* Set to 1 for !$ACC ROUTINE namespaces. */ unsigned oacc_routine:1; @@ -3187,6 +3234,7 @@ enum toc_directive { TOC_OPENMP, TOC_OPENMP_DECLARE_SIMD, + TOC_OPENMP_DECLARE_MAPPER, TOC_OPENMP_EXIT_DATA, TOC_OPENACC, TOC_OPENACC_DECLARE @@ -3637,9 +3685,13 @@ void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list); void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_free_omp_udr (gfc_omp_udr *); +void gfc_free_omp_udm (gfc_omp_udm *); gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *); void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *); void gfc_resolve_omp_assumptions (gfc_omp_assumptions *); +gfc_omp_udm *gfc_omp_udm_find (gfc_symtree *, gfc_typespec *); +gfc_omp_udm *gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, + gfc_typespec *ts); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool); void gfc_resolve_omp_local_vars (gfc_namespace *); @@ -3647,6 +3699,10 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_declare_simd (gfc_namespace *); void gfc_resolve_omp_udrs (gfc_symtree *); +void gfc_resolve_omp_udms (gfc_symtree *); +void gfc_omp_instantiate_mappers (gfc_code *, gfc_omp_clauses *, + toc_directive = TOC_OPENMP, + int = OMP_LIST_MAP); void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *); void gfc_omp_restore_state (struct gfc_omp_saved_state *); void gfc_free_expr_list (gfc_expr_list *); @@ -3896,6 +3952,7 @@ bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *, /* trans.cc */ void gfc_generate_code (gfc_namespace *); void gfc_generate_module_code (gfc_namespace *); +location_t gfc_get_location (locus *); /* trans-intrinsic.cc */ bool gfc_inline_intrinsic_function_p (gfc_expr *); diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index dd72a03027a1..c05a991a2fad 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -5539,6 +5539,9 @@ void gfc_free_omp_namelist (gfc_omp_namelist *name, int list) { bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND); + bool free_mapper = (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM); bool free_align_allocator = (list == OMP_LIST_ALLOCATE); bool free_mem_traits_space = (list == OMP_LIST_USES_ALLOCATORS); gfc_omp_namelist *n; @@ -5556,7 +5559,9 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, int list) gfc_free_expr (name->u2.allocator); else if (free_mem_traits_space) { } /* name->u2.traits_sym: shall not call gfc_free_symbol here. */ - else if (name->u2.udr) + else if (free_mapper && name->u2.udm) + free (name->u2.udm); + else if (!free_mapper && name->u2.udr) { if (name->u2.udr->combiner) gfc_free_statement (name->u2.udr->combiner); diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 7d72725ed3c6..9f75a6448f45 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -158,6 +158,7 @@ match gfc_match_omp_barrier (void); match gfc_match_omp_cancel (void); match gfc_match_omp_cancellation_point (void); match gfc_match_omp_critical (void); +match gfc_match_omp_declare_mapper (void); match gfc_match_omp_declare_reduction (void); match gfc_match_omp_declare_simd (void); match gfc_match_omp_declare_target (void); diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index 95fdda6b2aac..b1749f52f1a1 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -2081,7 +2081,8 @@ enum ab_attribute AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP, AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION, AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER, - AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET, + AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, + AB_OMP_DECLARE_MAPPER_VAR, AB_OMP_DECLARE_TARGET, AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE, AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR, AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK, @@ -2149,6 +2150,7 @@ static const mstring attr_bits[] = minit ("CLASS_POINTER", AB_CLASS_POINTER), minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE), minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY), + minit ("OMP_DECLARE_MAPPER_VAR", AB_OMP_DECLARE_MAPPER_VAR), minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET), minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY), minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE), @@ -2369,6 +2371,8 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits); if (attr->vtab) MIO_NAME (ab_attribute) (AB_VTAB, attr_bits); + if (attr->omp_udm_artificial_var) + MIO_NAME (ab_attribute) (AB_OMP_DECLARE_MAPPER_VAR, attr_bits); if (attr->omp_declare_target) MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits); if (attr->array_outer_dependency) @@ -2626,6 +2630,17 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_VTAB: attr->vtab = 1; break; + case AB_OMP_DECLARE_MAPPER_VAR: + attr->omp_udm_artificial_var = 1; + /* For the placeholder variable used in an !$OMP DECLARE MAPPER, + we don't know if the final clauses will reference used + variables or not, yet. Make sure the clause list doesn't get + skipped in trans-openmp.cc by forcing the variable referenced + attribute true here (else on reading the module, the symbol is + created with "referenced" false, and nothing else sets it to + true). */ + attr->referenced = 1; + break; case AB_OMP_DECLARE_TARGET: attr->omp_declare_target = 1; break; @@ -5134,6 +5149,135 @@ load_omp_udrs (void) } +/* We only need some of the enumeration values of gfc_omp_map_op for mapping + ops in the "!$omp declare mapper" clause list. */ + +static const mstring omp_map_clause_ops[] = +{ + minit ("ALLOC", OMP_MAP_ALLOC), + minit ("TO", OMP_MAP_TO), + minit ("FROM", OMP_MAP_FROM), + minit ("TOFROM", OMP_MAP_TOFROM), + minit ("ALWAYS_TO", OMP_MAP_ALWAYS_TO), + minit ("ALWAYS_FROM", OMP_MAP_ALWAYS_FROM), + minit ("ALWAYS_TOFROM", OMP_MAP_ALWAYS_TOFROM), + minit ("POINTER_ONLY", OMP_MAP_POINTER_ONLY), + minit ("UNSET", OMP_MAP_UNSET), + minit (NULL, -1) +}; + + +/* Whether a namelist in an "!$omp declare mapper" maps a single element or + multiple elements. */ + +static const mstring omp_map_cardinality[] = +{ + minit ("SINGLE", 0), + minit ("MULTIPLE", 1), + minit (NULL, -1) +}; + +/* This function loads OpenMP user-defined mappers. */ + +static void +load_omp_udms (void) +{ + mio_lparen (); + while (peek_atom () != ATOM_RPAREN) + { + const char *mapper_id = NULL; + gfc_symtree *st; + + mio_lparen (); + gfc_omp_udm *udm = gfc_get_omp_udm (); + + require_atom (ATOM_INTEGER); + pointer_info *udmpi = get_integer (atom_int); + associate_integer_pointer (udmpi, udm); + + mio_pool_string (&mapper_id); + + /* Note: for a derived-type typespec, we might not have loaded the + "u.derived" symbol yet. Defer checking duplicates until + check_omp_declare_mappers is called after loading all symbols. */ + mio_typespec (&udm->ts); + + if (mapper_id == NULL) + mapper_id = gfc_get_string ("%s", ""); + + st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id); + + pointer_info *p = mio_symbol_ref (&udm->var_sym); + pointer_info *q = get_integer (p->u.rsym.ns); + + udm->where = gfc_current_locus; + udm->mapper_id = mapper_id; + udm->mapper_ns = gfc_get_namespace (gfc_current_ns, 1); + udm->mapper_ns->proc_name = gfc_current_ns->proc_name; + udm->mapper_ns->omp_udm_ns = 1; + + associate_integer_pointer (q, udm->mapper_ns); + + gfc_omp_namelist *clauses = NULL; + gfc_omp_namelist **clausep = &clauses; + + mio_lparen (); + while (peek_atom () != ATOM_RPAREN) + { + /* Read each map clause. */ + gfc_omp_namelist *n = gfc_get_omp_namelist (); + + mio_lparen (); + + n->u.map_op = (gfc_omp_map_op) mio_name (0, omp_map_clause_ops); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + + mio_lparen (); + + if (peek_atom () != ATOM_RPAREN) + { + n->u2.udm = gfc_get_omp_namelist_udm (); + mio_pool_string (&n->u2.udm->mapper_id); + + if (n->u2.udm->mapper_id == NULL) + n->u2.udm->mapper_id = gfc_get_string ("%s", ""); + + n->u2.udm->multiple_elems_p = mio_name (0, omp_map_cardinality); + mio_pointer_ref (&n->u2.udm->udm); + } + + mio_rparen (); + + n->where = gfc_current_locus; + + mio_rparen (); + + *clausep = n; + clausep = &n->next; + } + mio_rparen (); + + udm->clauses = gfc_get_omp_clauses (); + udm->clauses->lists[OMP_LIST_MAP] = clauses; + + if (st) + { + udm->next = st->n.omp_udm; + st->n.omp_udm = udm; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id); + st->n.omp_udm = udm; + } + + mio_rparen (); + } + mio_rparen (); +} + + /* Recursive function to traverse the pointer_info tree and load a needed symbol. We return nonzero if we load a symbol and stop the traversal, because the act of loading can alter the tree. */ @@ -5324,12 +5468,44 @@ check_for_ambiguous (gfc_symtree *st, pointer_info *info) } +static void +check_omp_declare_mappers (gfc_symtree *st) +{ + if (!st) + return; + + check_omp_declare_mappers (st->left); + check_omp_declare_mappers (st->right); + + gfc_omp_udm **udmp = &st->n.omp_udm; + gfc_symtree tmp_st; + + while (*udmp) + { + gfc_omp_udm *udm = *udmp; + tmp_st.n.omp_udm = udm->next; + gfc_omp_udm *prev_udm = gfc_omp_udm_find (&tmp_st, &udm->ts); + if (prev_udm) + { + gfc_error ("Ambiguous !$OMP DECLARE MAPPER from module %s at %L", + udm->ts.u.derived->module, &udm->where); + gfc_error ("Previous !$OMP DECLARE MAPPER from module %s at %L", + prev_udm->ts.u.derived->module, &prev_udm->where); + /* Delete the duplicate. */ + *udmp = (*udmp)->next; + } + else + udmp = &(*udmp)->next; + } +} + + /* Read a module file. */ static void read_module (void) { - module_locus operator_interfaces, user_operators, omp_udrs; + module_locus operator_interfaces, user_operators, omp_udrs, omp_udms; const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; int i; @@ -5356,6 +5532,10 @@ read_module (void) get_module_locus (&omp_udrs); skip_list (); + /* Skip OpenMP UDMs. */ + get_module_locus (&omp_udms); + skip_list (); + mio_lparen (); /* Create the fixup nodes for all the symbols. */ @@ -5690,6 +5870,10 @@ read_module (void) set_module_locus (&omp_udrs); load_omp_udrs (); + /* Load OpenMP user defined mappers. */ + set_module_locus (&omp_udms); + load_omp_udms (); + /* At this point, we read those symbols that are needed but haven't been loaded yet. If one symbol requires another, the other gets marked as NEEDED if its previous state was UNUSED. */ @@ -5722,6 +5906,9 @@ read_module (void) module_name); } + /* Check "omp declare mappers" for duplicates from different modules. */ + check_omp_declare_mappers (gfc_current_ns->omp_udm_root); + /* Clean up symbol nodes that were never loaded, create references to hidden symbols. */ @@ -6100,6 +6287,66 @@ write_omp_udrs (gfc_symtree *st) } +static void +write_omp_udm (gfc_omp_udm *udm) +{ + /* If "!$omp declare mapper" type is private, don't write it. */ + if (!gfc_check_symbol_access (udm->ts.u.derived)) + return; + + mio_lparen (); + /* We need this pointer ref to identify this mapper so that other mappers + can refer to it. */ + mio_pointer_ref (&udm); + mio_pool_string (&udm->mapper_id); + mio_typespec (&udm->ts); + + if (udm->var_sym->module == NULL) + udm->var_sym->module = module_name; + + mio_symbol_ref (&udm->var_sym); + mio_lparen (); + gfc_omp_namelist *n; + for (n = udm->clauses->lists[OMP_LIST_MAP]; n; n = n->next) + { + mio_lparen (); + + mio_name (n->u.map_op, omp_map_clause_ops); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + + mio_lparen (); + + if (n->u2.udm) + { + mio_pool_string (&n->u2.udm->mapper_id); + mio_name (n->u2.udm->multiple_elems_p, omp_map_cardinality); + mio_pointer_ref (&n->u2.udm->udm); + } + + mio_rparen (); + + mio_rparen (); + } + mio_rparen (); + mio_rparen (); +} + + +static void +write_omp_udms (gfc_symtree *st) +{ + if (st == NULL) + return; + + write_omp_udms (st->left); + gfc_omp_udm *udm; + for (udm = st->n.omp_udm; udm; udm = udm->next) + write_omp_udm (udm); + write_omp_udms (st->right); +} + + /* Type for the temporary tree used when writing secondary symbols. */ struct sorted_pointer_info @@ -6361,6 +6608,12 @@ write_module (void) write_char ('\n'); write_char ('\n'); + mio_lparen (); + write_omp_udms (gfc_current_ns->omp_udm_root); + mio_rparen (); + write_char ('\n'); + write_char ('\n'); + /* Write symbol information. First we traverse all symbols in the primary namespace, writing those that need to be written. Sometimes writing one symbol will cause another to need to be diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 1e0da61e9693..585ffe035236 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -335,6 +335,19 @@ gfc_free_omp_udr (gfc_omp_udr *omp_udr) } +/* Free an !$omp declare mapper. */ + +void +gfc_free_omp_udm (gfc_omp_udm *omp_udm) +{ + if (omp_udm) + { + gfc_free_omp_udm (omp_udm->next); + gfc_free_namespace (omp_udm->mapper_ns); + free (omp_udm); + } +} + static gfc_omp_udr * gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts) { @@ -1854,6 +1867,44 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name) "clause at %L"); } + +/* Search upwards though namespace NS and its parents to find an + !$omp declare mapper named MAPPER_ID, for typespec TS. */ + +gfc_omp_udm * +gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, gfc_typespec *ts) +{ + gfc_symtree *st; + + if (ns == NULL) + ns = gfc_current_ns; + + do + { + gfc_omp_udm *omp_udm; + + st = gfc_find_symtree (ns->omp_udm_root, mapper_id); + + if (st != NULL) + { + for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next) + if (gfc_compare_types (&omp_udm->ts, ts)) + return omp_udm; + } + + /* Don't escape an interface block. */ + if (ns && !ns->has_import_set + && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY) + break; + + ns = ns->parent; + } + while (ns != NULL); + + return NULL; +} + + /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of clauses that are allowed for a particular directive. */ @@ -1861,7 +1912,8 @@ static match gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, bool first = true, bool needs_space = true, bool openacc = false, bool context_selector = false, - bool openmp_target = false) + bool openmp_target = false, + gfc_omp_map_op default_map_op = OMP_MAP_TOFROM) { bool error = false; gfc_omp_clauses *c = gfc_get_omp_clauses (); @@ -3012,9 +3064,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 mapper_modifier = 0; locus second_always_locus = old_loc2; locus second_close_locus = old_loc2; + locus second_mapper_locus = old_loc2; locus second_present_locus = old_loc2; + char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' }; for (;;) { @@ -3034,12 +3089,22 @@ 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 ("mapper ( ") == MATCH_YES) + { + if (mapper_modifier++ == 1) + second_mapper_locus = current_locus; + m = gfc_match (" %n ) ", mapper_id); + if (m != MATCH_YES) + goto error; + if (strcmp (mapper_id, "default") == 0) + mapper_id[0] = '\0'; + } else break; gfc_match (", "); } - gfc_omp_map_op map_op = OMP_MAP_TOFROM; + gfc_omp_map_op map_op = default_map_op; int always_present_modifier = always_modifier && present_modifier; @@ -3070,6 +3135,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, gfc_current_locus = old_loc2; always_modifier = 0; close_modifier = 0; + mapper_modifier = 0; } if (always_modifier > 1) @@ -3090,6 +3156,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, &second_present_locus); break; } + if (mapper_modifier > 1) + { + gfc_error ("too many % modifiers at %L", + &second_mapper_locus); + break; + } head = NULL; if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], @@ -3098,7 +3170,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, { gfc_omp_namelist *n; for (n = *head; n; n = n->next) - n->u.map_op = map_op; + { + n->u.map_op = map_op; + if (mapper_id[0] != '\0') + { + n->u2.udm = gfc_get_omp_namelist_udm (); + n->u2.udm->mapper_id + = gfc_get_string ("%s", mapper_id); + } + } continue; } gfc_current_locus = old_loc; @@ -4978,6 +5058,153 @@ gfc_match_omp_declare_simd (void) } +/* Find a matching "!$omp declare mapper" for typespec TS in symtree ST. */ + +gfc_omp_udm * +gfc_omp_udm_find (gfc_symtree *st, gfc_typespec *ts) +{ + gfc_omp_udm *omp_udm; + + if (st == NULL) + return NULL; + + for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next) + if ((omp_udm->ts.type == BT_DERIVED || omp_udm->ts.type == BT_CLASS) + && (ts->type == BT_DERIVED || ts->type == BT_CLASS) + && strcmp (omp_udm->ts.u.derived->name, ts->u.derived->name) == 0) + return omp_udm; + + return NULL; +} + + +match +gfc_match_omp_declare_mapper (void) +{ + match m; + gfc_typespec ts; + char mapper_id[GFC_MAX_SYMBOL_LEN + 1]; + char var[GFC_MAX_SYMBOL_LEN + 1]; + gfc_namespace *mapper_ns = NULL; + gfc_symtree *var_st; + gfc_symtree *st; + gfc_omp_udm *omp_udm = NULL, *prev_udm = NULL; + locus where = gfc_current_locus; + + if (gfc_match_char ('(') != MATCH_YES) + return MATCH_ERROR; + + locus old_locus = gfc_current_locus; + + m = gfc_match (" %n : ", mapper_id); + + if (m == MATCH_ERROR) + return MATCH_ERROR; + + /* As a special case, a mapper named "default" and an unnamed mapper are + both the default mapper for a given type. */ + if (strcmp (mapper_id, "default") == 0) + mapper_id[0] = '\0'; + + if (gfc_peek_ascii_char () == ':') + { + /* If we see '::', the user did not name the mapper, and instead we just + saw the type. So backtrack and try parsing as a type instead. */ + mapper_id[0] = '\0'; + gfc_current_locus = old_locus; + } + + /* This accepts 't' but not e.g. 'type(t)'. Is that correct? */ + m = gfc_match_type_spec (&ts); + if (m != MATCH_YES) + return MATCH_ERROR; + + if (ts.type != BT_DERIVED) + { + gfc_error_now ("!$OMP DECLARE MAPPER with non-derived type at %C"); + return MATCH_ERROR; + } + + if (gfc_match (" :: ") != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_name (var) != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_char (')') != MATCH_YES) + return MATCH_ERROR; + + st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id); + + /* Now we need to set up a new namespace, and create a new sym_tree for our + dummy variable so we can use it in the following list of mapping + clauses. */ + + gfc_current_ns = mapper_ns = gfc_get_namespace (gfc_current_ns, 1); + mapper_ns->proc_name = mapper_ns->parent->proc_name; + mapper_ns->omp_udm_ns = 1; + + gfc_get_sym_tree (var, mapper_ns, &var_st, false); + var_st->n.sym->ts = ts; + var_st->n.sym->attr.omp_udm_artificial_var = 1; + var_st->n.sym->attr.flavor = FL_VARIABLE; + gfc_commit_symbols (); + + gfc_omp_clauses *clauses = NULL; + + m = gfc_match_omp_clauses (&clauses, omp_mask (OMP_CLAUSE_MAP), true, true, + false, false, OMP_MAP_UNSET); + if (m != MATCH_YES) + goto failure; + + omp_udm = gfc_get_omp_udm (); + omp_udm->next = NULL; + omp_udm->where = where; + omp_udm->mapper_id = gfc_get_string ("%s", mapper_id); + omp_udm->ts = ts; + omp_udm->var_sym = var_st->n.sym; + omp_udm->mapper_ns = mapper_ns; + omp_udm->clauses = clauses; + + gfc_current_ns = mapper_ns->parent; + + prev_udm = gfc_omp_udm_find (st, &ts); + if (prev_udm) + { + gfc_error_now ("Redefinition of !$OMP DECLARE MAPPER at %L", &where); + gfc_error_now ("Previous !$OMP DECLARE MAPPER at %L", &prev_udm->where); + } + else if (st) + { + omp_udm->next = st->n.omp_udm; + st->n.omp_udm = omp_udm; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id); + st->n.omp_udm = omp_udm; + } + + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$OMP DECLARE MAPPER at %C"); + gfc_current_locus = where; + return MATCH_ERROR; + } + + return MATCH_YES; + +failure: + if (mapper_ns) + gfc_current_ns = mapper_ns->parent; + gfc_free_omp_udm (omp_udm); + + gfc_clear_error (); + + return MATCH_ERROR; +} + + static bool match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) { @@ -7315,7 +7542,7 @@ gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume) } /* Check OMP_CLAUSES for duplicate symbols and various other constraints. - Helper function for resolve_omp_clauses. */ + Helper function for resolve_omp_clauses and resolve_omp_mapper_clauses. */ static void omp_verify_clauses_symbol_dups (gfc_code *code, gfc_omp_clauses *omp_clauses, @@ -7710,7 +7937,8 @@ omp_verify_clauses_symbol_dups (gfc_code *code, gfc_omp_clauses *omp_clauses, } /* Check that the parameter of a MAP, TO and FROM clause N meets certain - constraints. Helper function for resolve_omp_clauses. */ + constraints. Helper function for resolve_omp_clauses and + resolve_omp_mapper_clauses. */ static bool omp_verify_map_motion_clauses (gfc_code *code, int list, const char *name, @@ -7973,6 +8201,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (omp_clauses->order_concurrent && omp_clauses->ordered) gfc_error ("ORDER clause must not be used together ORDERED at %L", &code->loc); + /* If we're invoking any declared mappers as a result of these clauses, we may + need to know the namespace their directive was originally defined within in + order to resolve clauses again after substitution. Record it here. */ + if (ns) + omp_clauses->ns = ns; if (omp_clauses->if_expr) { gfc_expr *expr = omp_clauses->if_expr; @@ -8359,6 +8592,36 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (!omp_verify_map_motion_clauses (code, list, name, n, openacc)) break; + if (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM) + { + gfc_typespec *ts; + + if (n->expr) + ts = &n->expr->ts; + else + ts = &n->sym->ts; + + const char *mapper_id + = n->u2.udm ? n->u2.udm->mapper_id : ""; + + gfc_omp_udm *udm = gfc_find_omp_udm (gfc_current_ns, + mapper_id, ts); + if (mapper_id[0] != '\0' && !udm) + gfc_error ("User-defined mapper %qs not found at %L", + mapper_id, &n->where); + else if (udm) + { + if (!n->u2.udm) + { + n->u2.udm = gfc_get_omp_namelist_udm (); + gcc_assert (mapper_id[0] == '\0'); + n->u2.udm->mapper_id = mapper_id; + } + n->u2.udm->udm = udm; + } + } } if (list != OMP_LIST_DEPEND) @@ -8963,6 +9226,47 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } +/* This very simplified version of the above function is for use after mapper + instantiation. It avoids dealing with anything other than basic + verification for map/to/from clauses. */ + +static void +resolve_omp_mapper_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, + gfc_namespace *ns) +{ + gfc_omp_namelist *n; + int list; + + omp_verify_clauses_symbol_dups (code, omp_clauses, ns, false); + + for (list = OMP_LIST_MAP; list <= OMP_LIST_FROM; list++) + if ((n = omp_clauses->lists[list]) != NULL) + { + const char *name = NULL; + switch (list) + { + case OMP_LIST_MAP: + if (name == NULL) + name = "MAP"; + /* Fallthrough. */ + case OMP_LIST_TO: + if (name == NULL) + name = "TO"; + /* Fallthrough. */ + case OMP_LIST_FROM: + if (name == NULL) + name = "FROM"; + for (; n != NULL; n = n->next) + if (!omp_verify_map_motion_clauses (code, list, name, n, false)) + break; + break; + default: + ; + } + } +} + + /* Return true if SYM is ever referenced in EXPR except in the SE node. */ static bool @@ -10799,11 +11103,11 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_WORKSHARE: case EXEC_OMP_DEPOBJ: if (code->ext.omp_clauses) - resolve_omp_clauses (code, code->ext.omp_clauses, NULL); + resolve_omp_clauses (code, code->ext.omp_clauses, ns); break; case EXEC_OMP_TARGET_UPDATE: if (code->ext.omp_clauses) - resolve_omp_clauses (code, code->ext.omp_clauses, NULL); + resolve_omp_clauses (code, code->ext.omp_clauses, ns); if (code->ext.omp_clauses == NULL || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL)) @@ -10999,3 +11303,471 @@ gfc_resolve_omp_udrs (gfc_symtree *st) for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) gfc_resolve_omp_udr (omp_udr); } + +static enum gfc_omp_map_op +omp_split_map_op (enum gfc_omp_map_op op, bool *force_p, bool *always_p, + bool *present_p) +{ + *force_p = *always_p = *present_p = false; + + switch (op) + { + case OMP_MAP_FORCE_ALLOC: + case OMP_MAP_FORCE_TO: + case OMP_MAP_FORCE_FROM: + case OMP_MAP_FORCE_TOFROM: + case OMP_MAP_FORCE_PRESENT: + *force_p = true; + break; + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_ALWAYS_TOFROM: + *always_p = true; + break; + case OMP_MAP_ALWAYS_PRESENT_TO: + case OMP_MAP_ALWAYS_PRESENT_FROM: + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + *always_p = true; + /* Fallthrough. */ + case OMP_MAP_PRESENT_ALLOC: + case OMP_MAP_PRESENT_TO: + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_PRESENT_TOFROM: + *present_p = true; + break; + default: + ; + } + + switch (op) + { + case OMP_MAP_ALLOC: + case OMP_MAP_FORCE_ALLOC: + case OMP_MAP_PRESENT_ALLOC: + return OMP_MAP_ALLOC; + case OMP_MAP_TO: + case OMP_MAP_FORCE_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_PRESENT_TO: + case OMP_MAP_ALWAYS_PRESENT_TO: + return OMP_MAP_TO; + case OMP_MAP_FROM: + case OMP_MAP_FORCE_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_ALWAYS_PRESENT_FROM: + return OMP_MAP_FROM; + case OMP_MAP_TOFROM: + case OMP_MAP_FORCE_TOFROM: + case OMP_MAP_ALWAYS_TOFROM: + case OMP_MAP_PRESENT_TOFROM: + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + return OMP_MAP_TOFROM; + default: + ; + } + return op; +} + +static enum gfc_omp_map_op +omp_join_map_op (enum gfc_omp_map_op op, bool force_p, bool always_p, + bool present_p) +{ + gcc_assert (!force_p || !(always_p || present_p)); + + switch (op) + { + case OMP_MAP_ALLOC: + if (force_p) + return OMP_MAP_FORCE_ALLOC; + else if (present_p) + return OMP_MAP_PRESENT_ALLOC; + break; + + case OMP_MAP_TO: + if (force_p) + return OMP_MAP_FORCE_TO; + else if (always_p && present_p) + return OMP_MAP_ALWAYS_PRESENT_TO; + else if (always_p) + return OMP_MAP_ALWAYS_TO; + else if (present_p) + return OMP_MAP_PRESENT_TO; + break; + + case OMP_MAP_FROM: + if (force_p) + return OMP_MAP_FORCE_FROM; + else if (always_p && present_p) + return OMP_MAP_ALWAYS_PRESENT_FROM; + else if (always_p) + return OMP_MAP_ALWAYS_FROM; + else if (present_p) + return OMP_MAP_PRESENT_FROM; + break; + + case OMP_MAP_TOFROM: + if (force_p) + return OMP_MAP_FORCE_TOFROM; + else if (always_p && present_p) + return OMP_MAP_ALWAYS_PRESENT_TOFROM; + else if (always_p) + return OMP_MAP_ALWAYS_TOFROM; + else if (present_p) + return OMP_MAP_PRESENT_TOFROM; + break; + + default: + ; + } + + return op; +} + +/* Map kind decay (OpenMP 5.2, 5.8.8 "declare mapper Directive"). Return the + map kind to use given MAPPER_KIND specified in the mapper and INVOKED_AS + specified on the clause that invokes the mapper. See also + c-family/c-omp.cc:omp_map_decayed_kind. */ + +static enum gfc_omp_map_op +omp_map_decayed_kind (enum gfc_omp_map_op mapper_kind, + enum gfc_omp_map_op invoked_as, bool exit_p) +{ + if (invoked_as == OMP_MAP_RELEASE || invoked_as == OMP_MAP_DELETE) + return invoked_as; + + bool force_p, always_p, present_p; + + invoked_as = omp_split_map_op (invoked_as, &force_p, &always_p, &present_p); + gfc_omp_map_op decay_to; + + switch (mapper_kind) + { + case OMP_MAP_ALLOC: + if (exit_p && invoked_as == OMP_MAP_FROM) + decay_to = OMP_MAP_RELEASE; + else + decay_to = OMP_MAP_ALLOC; + break; + + case OMP_MAP_TO: + if (invoked_as == OMP_MAP_FROM) + decay_to = exit_p ? OMP_MAP_RELEASE : OMP_MAP_ALLOC; + else if (invoked_as == OMP_MAP_ALLOC) + decay_to = OMP_MAP_ALLOC; + else + decay_to = OMP_MAP_TO; + break; + + case OMP_MAP_FROM: + if (invoked_as == OMP_MAP_ALLOC || invoked_as == OMP_MAP_TO) + decay_to = OMP_MAP_ALLOC; + else + decay_to = OMP_MAP_FROM; + break; + + case OMP_MAP_TOFROM: + case OMP_MAP_UNSET: + decay_to = invoked_as; + break; + + default: + gcc_unreachable (); + } + + return omp_join_map_op (decay_to, force_p, always_p, present_p); +} + +static const char * +omp_basic_map_kind_name (enum gfc_omp_map_op op) +{ + switch (op) + { + case OMP_MAP_ALLOC: + return "ALLOC"; + case OMP_MAP_TO: + return "TO"; + case OMP_MAP_FROM: + return "FROM"; + case OMP_MAP_TOFROM: + return "TOFROM"; + case OMP_MAP_RELEASE: + return "RELEASE"; + case OMP_MAP_DELETE: + return "DELETE"; + default: + gcc_unreachable (); + } +} + +static gfc_symtree *gfc_subst_replace; +static gfc_ref *gfc_subst_prepend_ref; + +static bool +gfc_subst_in_expr_1 (gfc_expr *expr, gfc_symbol *search, int *) +{ + /* The base-object for component accesses may be stored in expr->symtree. + If it's the symbol for our "declare mapper" placeholder variable, + substitute it. */ + if (expr->symtree && expr->symtree->n.sym == search) + { + gfc_ref **lastptr = NULL; + expr->symtree = gfc_subst_replace; + + if (!gfc_subst_prepend_ref) + return false; + + gfc_ref *prepend_ref = gfc_copy_ref (gfc_subst_prepend_ref); + + for (gfc_ref *walk = prepend_ref; walk; walk = walk->next) + lastptr = &walk->next; + + *lastptr = expr->ref; + expr->ref = prepend_ref; + } + + return false; +} + +static void +gfc_subst_in_expr (gfc_expr *expr, gfc_symbol *search, gfc_symtree *replace, + gfc_ref *prepend_ref) +{ + gfc_subst_replace = replace; + gfc_subst_prepend_ref = prepend_ref; + gfc_traverse_expr (expr, search, gfc_subst_in_expr_1, 0); +} + +static void +gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr, + gfc_symbol *orig_sym, gfc_expr *orig_expr, + gfc_symbol *dummy_var, + gfc_symbol *templ_sym, gfc_expr *templ_expr) +{ + gfc_ref *orig_ref = orig_expr ? orig_expr->ref : NULL; + gfc_symtree *orig_st = gfc_find_symtree (orig_sym->ns->sym_root, + orig_sym->name); + + if (dummy_var == templ_sym) + *out_sym = orig_sym; + else + *out_sym = templ_sym; + + if (templ_expr) + { + *out_expr = gfc_copy_expr (templ_expr); + gfc_subst_in_expr (*out_expr, dummy_var, orig_st, orig_ref); + } + else if (orig_expr) + *out_expr = gfc_copy_expr (orig_expr); + else + *out_expr = NULL; +} + +static gfc_omp_namelist ** +gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp, + gfc_omp_namelist *clause, + gfc_omp_map_op outer_map_op, gfc_omp_udm *udm, + toc_directive cd, int list) +{ + /* Here "sym" and "expr" describe the clause as written, to be substituted + for the dummy variable in the mapper definition. */ + struct gfc_symbol *sym = clause->sym; + struct gfc_expr *expr = clause->expr; + gfc_omp_namelist *mapper_clause = udm->clauses->lists[OMP_LIST_MAP]; + bool pointer_needed_p = false; + + if (expr) + { + gfc_ref *lastref = expr->ref, *lastcomp = NULL; + + for (; lastref->next; lastref = lastref->next) + if (lastref->type == REF_COMPONENT) + lastcomp = lastref; + + if (lastref + && lastref->type == REF_ARRAY + && (lastref->u.ar.type == AR_SECTION + || lastref->u.ar.type == AR_FULL)) + { + mpz_t elems; + bool multiple_elems_p = false; + + if (gfc_array_size (expr, &elems)) + { + HOST_WIDE_INT nelems = gfc_mpz_get_hwi (elems); + if (nelems > 1) + multiple_elems_p = true; + } + else + multiple_elems_p = true; + + if (multiple_elems_p && clause->u2.udm) + { + clause->u2.udm->multiple_elems_p = true; + *outlistp = clause; + return &(*outlistp)->next; + } + } + + if (lastcomp + && lastcomp->type == REF_COMPONENT + && (lastcomp->u.c.component->attr.pointer + || lastcomp->u.c.component->attr.allocatable)) + pointer_needed_p = true; + } + + if (pointer_needed_p) + { + /* If we're instantiating a mapper via a pointer, we need to map that + pointer as well as mapping the entities explicitly listed in the + mapper definition. Create a node for that. */ + gfc_omp_namelist *new_clause = gfc_get_omp_namelist (); + new_clause->sym = sym; + new_clause->expr = gfc_copy_expr (expr); + /* We want the pointer itself: cut off any further accessors after the + last component reference (e.g. array indices). */ + gfc_ref *lastcomp = NULL; + for (gfc_ref *lastref = new_clause->expr->ref; + lastref; + lastref = lastref->next) + if (lastref->type == REF_COMPONENT) + lastcomp = lastref; + gcc_assert (lastcomp != NULL); + lastcomp->next = NULL; + new_clause->u.map_op = OMP_MAP_POINTER_ONLY; + *outlistp = new_clause; + outlistp = &new_clause->next; + } + + for (; mapper_clause; mapper_clause = mapper_clause->next) + { + gfc_omp_namelist *new_clause = gfc_get_omp_namelist (); + + gfc_subst_mapper_var (&new_clause->sym, &new_clause->expr, + sym, expr, udm->var_sym, mapper_clause->sym, + mapper_clause->expr); + + enum gfc_omp_map_op map_clause_op = mapper_clause->u.map_op; + enum gfc_omp_map_op new_kind + = omp_map_decayed_kind (map_clause_op, outer_map_op, + (cd == TOC_OPENMP_EXIT_DATA + || list == OMP_LIST_FROM)); + if (list == OMP_LIST_FROM || list == OMP_LIST_TO) + { + switch (new_kind) + { + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_PRESENT_TO: + new_clause->u.present_modifier = true; + /* Fallthrough. */ + case OMP_MAP_FROM: + case OMP_MAP_TO: + break; + default: + { + bool present_p, force_p, always_p; + gfc_omp_map_op basic_kind + = omp_split_map_op (map_clause_op, &force_p, &always_p, + &present_p); + free (new_clause); + gfc_warning (0, "Dropping incompatible %qs mapper clause at %C", + omp_basic_map_kind_name (basic_kind)); + inform (gfc_get_location (&mapper_clause->where), + "Defined here"); + continue; + } + } + } + else + new_clause->u.map_op = new_kind; + + new_clause->where = clause->where; + + if (mapper_clause->u2.udm + && mapper_clause->u2.udm->udm != udm) + { + gfc_omp_udm *inner_udm = mapper_clause->u2.udm->udm; + outlistp = gfc_omp_instantiate_mapper (outlistp, new_clause, + outer_map_op, inner_udm, cd, + list); + } + else + { + *outlistp = new_clause; + outlistp = &new_clause->next; + } + } + + return outlistp; +} + +void +gfc_omp_instantiate_mappers (gfc_code *code, gfc_omp_clauses *clauses, + toc_directive cd, int list) +{ + gfc_omp_namelist *clause = clauses->lists[list]; + gfc_omp_namelist **clausep = &clauses->lists[list]; + bool invoked_mappers = false; + + for (; clause; clause = *clausep) + { + if (clause->u2.udm) + { + gfc_omp_map_op outer_map_op; + + switch (list) + { + case OMP_LIST_TO: + outer_map_op = clause->u.present_modifier ? OMP_MAP_PRESENT_TO + : OMP_MAP_TO; + break; + case OMP_LIST_FROM: + outer_map_op = clause->u.present_modifier ? OMP_MAP_PRESENT_FROM + : OMP_MAP_FROM; + break; + case OMP_LIST_MAP: + outer_map_op = clause->u.map_op; + break; + default: + gcc_unreachable (); + } + clausep = gfc_omp_instantiate_mapper (clausep, clause, outer_map_op, + clause->u2.udm->udm, cd, list); + *clausep = clause->next; + invoked_mappers = true; + } + else + clausep = &clause->next; + } + + if (invoked_mappers) + { + gfc_namespace *old_ns = gfc_current_ns; + if (clauses->ns) + gfc_current_ns = clauses->ns; + resolve_omp_mapper_clauses (code, clauses, gfc_current_ns); + gfc_current_ns = old_ns; + } +} + +/* Resolve !$omp declare mapper constructs. */ + +static void +gfc_resolve_omp_udm (gfc_omp_udm *omp_udm) +{ + resolve_omp_clauses (NULL, omp_udm->clauses, omp_udm->mapper_ns); +} + +void +gfc_resolve_omp_udms (gfc_symtree *st) +{ + gfc_omp_udm *omp_udm; + + if (st == NULL) + return; + gfc_resolve_omp_udms (st->left); + gfc_resolve_omp_udms (st->right); + for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next) + gfc_resolve_omp_udm (omp_udm); +} diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index b81804755f12..124a2f6a8b7d 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -945,6 +945,8 @@ decode_omp_directive (void) matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME); break; case 'd': + matchdo ("declare mapper", gfc_match_omp_declare_mapper, + ST_OMP_DECLARE_MAPPER); matchds ("declare reduction", gfc_match_omp_declare_reduction, ST_OMP_DECLARE_REDUCTION); matchds ("declare simd", gfc_match_omp_declare_simd, @@ -1877,8 +1879,9 @@ next_statement (void) the specification part. */ #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \ - case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \ - case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \ + case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_MAPPER: \ + case ST_OMP_DECLARE_REDUCTION: case ST_OMP_DECLARE_VARIANT: \ + case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \ case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE /* Block end statements. Errors associated with interchanging these @@ -2527,6 +2530,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) case ST_OMP_CRITICAL: p = "!$OMP CRITICAL"; break; + case ST_OMP_DECLARE_MAPPER: + p = "!$OMP DECLARE MAPPER"; + break; case ST_OMP_DECLARE_REDUCTION: p = "!$OMP DECLARE REDUCTION"; break; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index e7c8d919bef0..867ce7ca9156 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -18010,6 +18010,8 @@ resolve_types (gfc_namespace *ns) gfc_resolve_omp_udrs (ns->omp_udr_root); + gfc_resolve_omp_udms (ns->omp_udm_root); + ns->types_resolved = 1; gfc_current_ns = old_ns; diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index aa3cdc98c86f..b969a4291671 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -3880,6 +3880,21 @@ free_omp_udr_tree (gfc_symtree * omp_udr_tree) free (omp_udr_tree); } +/* Similar, for !$omp declare mappers. */ + +static void +free_omp_udm_tree (gfc_symtree *omp_udm_tree) +{ + if (omp_udm_tree == NULL) + return; + + free_omp_udm_tree (omp_udm_tree->left); + free_omp_udm_tree (omp_udm_tree->right); + + gfc_free_omp_udm (omp_udm_tree->n.omp_udm); + free (omp_udm_tree); +} + /* Recursive function that deletes an entire tree and all the user operator nodes that it contains. */ @@ -4054,6 +4069,7 @@ gfc_free_namespace (gfc_namespace *&ns) free_uop_tree (ns->uop_root); free_common_tree (ns->common_root); free_omp_udr_tree (ns->omp_udr_root); + free_omp_udm_tree (ns->omp_udm_root); free_tb_tree (ns->tb_sym_root); free_tb_tree (ns->tb_uop_root); gfc_free_finalizer_list (ns->finalizers); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index b0fd25e92a3b..adf0798b0564 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -88,6 +88,11 @@ static stmtblock_t caf_init_block; tree gfc_static_ctors; +/* The namespace in which to look up "declare mapper" mappers (in + trans-openmp.cc:gfc_trans_omp_target). This is somewhat grubby. */ + +gfc_namespace *omp_declare_mapper_ns; + /* Whether we've seen a symbol from an IEEE module in the namespace. */ static int seen_ieee_symbol; @@ -639,9 +644,12 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) function scope. */ if (current_function_decl != NULL_TREE) { - if (sym->ns->proc_name - && (sym->ns->proc_name->backend_decl == current_function_decl - || sym->result == sym)) + if (sym->ns->omp_udm_ns) + /* ...except for in omp declare mappers, which are special. */ + pushdecl (decl); + else if (sym->ns->proc_name + && (sym->ns->proc_name->backend_decl == current_function_decl + || sym->result == sym)) gfc_add_decl_to_function (decl); else if (sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_LABEL) @@ -4661,6 +4669,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (sym->assoc) continue; + if (sym->attr.omp_udm_artificial_var) + continue; + /* Set the vptr of unlimited polymorphic pointer variables so that they do not cause segfaults in select type, when the selector is an intrinsic type. */ @@ -7678,6 +7689,16 @@ gfc_generate_function_code (gfc_namespace * ns) gfc_conv_cfi_to_gfc (&init, &cleanup, tmp, desc, fsym); } + { + tree dm_saved_parent_function_decls = saved_parent_function_decls; + saved_parent_function_decls = saved_function_decls; + /* NOTE: Decls referenced in a mapper (other than the placeholder variable) + may be added to "saved_parent_function_decls". */ + gfc_trans_omp_declare_mappers (ns->omp_udm_root); + saved_function_decls = saved_parent_function_decls; + saved_parent_function_decls = dm_saved_parent_function_decls; + } + gfc_generate_contained_functions (ns); has_coarray_vars = false; @@ -7746,9 +7767,15 @@ gfc_generate_function_code (gfc_namespace * ns) finish_oacc_declare (ns, sym, false); + /* Record the namespace for looking up OpenMP declare mappers in. */ + omp_declare_mapper_ns = ns; + tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); + /* Unset this to avoid accidentally using a stale pointer. */ + omp_declare_mapper_ns = NULL; + if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node || (sym->result && sym->result != sym && sym->result->ts.type == BT_DERIVED diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 829b28b24c79..95ce33797d62 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -49,6 +49,7 @@ along with GCC; see the file COPYING3. If not see #define GCC_DIAG_STYLE __gcc_gfc__ #include "attribs.h" #include "function.h" +#include "tree-iterator.h" int ompws_flags; @@ -2553,6 +2554,107 @@ gfc_trans_omp_array_section (stmtblock_t *block, toc_directive cd, ptr, ptr2); } +/* CLAUSES is a list of clauses resulting from an "omp declare mapper" + instantiation in gimplify.cc. In some cases we don't know if we need to + create any extra mapping nodes as a result of mapper expansion until after + substitution has taken place, so do that now. */ + +tree +gfc_omp_finish_mapper_clauses (tree clauses) +{ + tree *clausep = &clauses; + + while (*clausep) + { + tree n = *clausep; + + if (OMP_CLAUSE_CODE (n) != OMP_CLAUSE_MAP) + { + clausep = &OMP_CLAUSE_CHAIN (*clausep); + continue; + } + + tree decl = OMP_CLAUSE_DECL (n); + + switch (OMP_CLAUSE_MAP_KIND (n)) + { + case GOMP_MAP_ALLOC: + case GOMP_MAP_TO: + case GOMP_MAP_FROM: + case GOMP_MAP_TOFROM: + case GOMP_MAP_ALWAYS_TO: + case GOMP_MAP_ALWAYS_FROM: + case GOMP_MAP_ALWAYS_TOFROM: + { + if ((TREE_CODE (decl) == INDIRECT_REF + || (TREE_CODE (decl) == MEM_REF + && integer_zerop (TREE_OPERAND (decl, 1)))) + && DECL_P (TREE_OPERAND (decl, 0))) + { + tree ptr = TREE_OPERAND (decl, 0); + /* A DECL_P pointer arising from a mapper expansion needs a + GOMP_MAP_POINTER after it. */ + tree pnode = build_omp_clause (OMP_CLAUSE_LOCATION (n), + OMP_CLAUSE_MAP); + /* Should this ever be FIRSTPRIVATE_POINTER or + FIRSTPRIVATE_REFERENCE? */ + OMP_CLAUSE_SET_MAP_KIND (pnode, GOMP_MAP_POINTER); + OMP_CLAUSE_DECL (pnode) = ptr; + OMP_CLAUSE_SIZE (pnode) = size_zero_node; + OMP_CLAUSE_CHAIN (pnode) = OMP_CLAUSE_CHAIN (n); + OMP_CLAUSE_CHAIN (n) = pnode; + clausep = &OMP_CLAUSE_CHAIN (pnode); + continue; + } + } + break; + + default: + ; + } + + clausep = &OMP_CLAUSE_CHAIN (*clausep); + } + + return clauses; +} + +tree +gfc_omp_extract_mapper_directive (tree fndecl) +{ + tree body = DECL_SAVED_TREE (fndecl); + + if (TREE_CODE (body) == BIND_EXPR) + body = BIND_EXPR_BODY (body); + + if (TREE_CODE (body) == OMP_DECLARE_MAPPER) + return body; + + if (TREE_CODE (body) != STATEMENT_LIST) + return error_mark_node; + + tree_stmt_iterator tsi; + for (tsi = tsi_start (body); !tsi_end_p (tsi); tsi_next (&tsi)) + { + tree stmt = tsi_stmt (tsi); + if (TREE_CODE (stmt) == OMP_DECLARE_MAPPER) + { + gcc_assert (tsi_one_before_end_p (tsi)); + return stmt; + } + } + + return error_mark_node; +} + +tree +gfc_omp_map_array_section (location_t, tree section) +{ + /* For Fortran, detection of attempts to use array sections or full arrays + whose elements are mapped with a mapper happens elsewhere. */ + return section; +} + static tree handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block) { @@ -2685,6 +2787,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { bool declare_simd = (cd == TOC_OPENMP_DECLARE_SIMD); bool openacc = (cd >= TOC_OPENACC); + bool declare_mapper = (cd == TOC_OPENMP_DECLARE_MAPPER); bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA); tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c; tree iterator = NULL_TREE; @@ -3209,6 +3312,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_MAP_FORCE_DEVICEPTR: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR); break; + case OMP_MAP_POINTER_ONLY: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC); + break; + case OMP_MAP_UNSET: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_UNSET); + break; default: gcc_unreachable (); } @@ -3676,8 +3785,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (ref->u.ar.type == AR_ELEMENT && ref->next) gfc_conv_array_ref (&se, &ref->u.ar, n->expr, &n->expr->where); - else - gcc_assert (!ref->next); + else if (ref->next) + { + gfc_error ("cannot map array in expression " + "at %C"); + OMP_CLAUSE_DECL (node) = error_mark_node; + OMP_CLAUSE_SIZE (node) = NULL_TREE; + node2 = NULL_TREE; + goto finalize_map_clause; + } } else sorry ("unhandled expression type"); @@ -3704,6 +3820,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node) = size_zero_node; goto finalize_map_clause; } + else if (n->u.map_op == OMP_MAP_POINTER_ONLY) + { + /* A descriptor must be copied to the target. */ + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + OMP_CLAUSE_SET_MAP_KIND (node, + GOMP_MAP_ALWAYS_TO); + OMP_CLAUSE_DECL (node) = inner; + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (inner)); + goto finalize_map_clause; + } gfc_omp_namelist *n2 = openacc ? NULL : clauses->lists[OMP_LIST_MAP]; @@ -3804,6 +3931,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node) = size_zero_node; goto finalize_map_clause; } + else if (n->u.map_op == OMP_MAP_POINTER_ONLY) + { + /* A descriptor must be copied to the target. */ + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO); + OMP_CLAUSE_DECL (node) = inner; + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (inner)); + goto finalize_map_clause; + } if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) { @@ -3938,6 +4075,14 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } if (drop_mapping) continue; + + if (n->u2.udm && n->u2.udm->multiple_elems_p) + { + gfc_error ("cannot map non-unit size array " + "with mapper at %C"); + node2 = NULL_TREE; + goto finalize_map_clause; + } } node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP); @@ -3978,15 +4123,77 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, finalize_map_clause: - omp_clauses = gfc_trans_add_clause (node, omp_clauses); - if (node2) - omp_clauses = gfc_trans_add_clause (node2, omp_clauses); - if (node3) - omp_clauses = gfc_trans_add_clause (node3, omp_clauses); - if (node4) - omp_clauses = gfc_trans_add_clause (node4, omp_clauses); - if (node5) - omp_clauses = gfc_trans_add_clause (node5, omp_clauses); + /* If we're processing an "omp declare mapper" directive, group + together multiple nodes used for some given map clause using + GOMP_MAP_MAPPING_GROUP. These are then either flattened or + appropriately transformed if they cause a nested mapper to be + invoked. */ + + if (declare_mapper) + { + tree cl, container; + + if (node2 || node3 || node4 || node5) + cl = tree_cons (node, NULL_TREE, NULL_TREE); + else + cl = node; + + if (node2) + cl = tree_cons (node2, NULL_TREE, cl); + if (node3) + cl = tree_cons (node3, NULL_TREE, cl); + if (node4) + cl = tree_cons (node4, NULL_TREE, cl); + if (node5) + cl = tree_cons (node5, NULL_TREE, cl); + + if (node != cl) + { + cl = nreverse (cl); + + container = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (container, + GOMP_MAP_MAPPING_GROUP); + OMP_CLAUSE_DECL (container) = cl; + } + else + container = cl; + + if (n->u2.udm + && n->u2.udm->udm->mapper_id + && n->u2.udm->udm->mapper_id[0] != '\0') + { + tree push = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (push, GOMP_MAP_PUSH_MAPPER_NAME); + OMP_CLAUSE_DECL (push) + = get_identifier (n->u2.udm->udm->mapper_id); + tree pop = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (pop, GOMP_MAP_POP_MAPPER_NAME); + OMP_CLAUSE_DECL (pop) = null_pointer_node; + omp_clauses = gfc_trans_add_clause (push, omp_clauses); + omp_clauses = gfc_trans_add_clause (container, + omp_clauses); + omp_clauses = gfc_trans_add_clause (pop, omp_clauses); + } + else + omp_clauses = gfc_trans_add_clause (container, omp_clauses); + } + else + { + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + + if (node2) + omp_clauses = gfc_trans_add_clause (node2, omp_clauses); + if (node3) + omp_clauses = gfc_trans_add_clause (node3, omp_clauses); + if (node4) + omp_clauses = gfc_trans_add_clause (node4, omp_clauses); + if (node5) + omp_clauses = gfc_trans_add_clause (node5, omp_clauses); + } } break; case OMP_LIST_TO: @@ -7568,6 +7775,158 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, return gfc_finish_block (&block); } +/* Code callback for gfc_code_walker. */ + +static int +gfc_record_mapper_bindings_code_fn (gfc_code **, int *, void *) +{ + return 0; +} + +template <> +struct default_hash_traits > + : typed_noop_remove > +{ + GTY((skip)) typedef omp_name_type value_type; + GTY((skip)) typedef omp_name_type compare_type; + + static hashval_t + hash (omp_name_type p) + { + tree typenode = gfc_typenode_for_spec (p.type); + return p.name ? iterative_hash_expr (p.name, TYPE_UID (typenode)) + : TYPE_UID (typenode); + } + + static const bool empty_zero_p = true; + + static bool + is_empty (omp_name_type p) + { + return p.type == NULL; + } + + static bool + is_deleted (omp_name_type) + { + return false; + } + + static bool + equal (const omp_name_type &a, + const omp_name_type &b) + { + if (a.name == NULL_TREE && b.name == NULL_TREE) + return a.type == b.type; + else if (a.name == NULL_TREE || b.name == NULL_TREE) + return false; + else + return a.name == b.name && gfc_compare_types (a.type, b.type); + } + + static void + mark_empty (omp_name_type &e) + { + e.type = NULL; + } +}; + + +extern gfc_namespace *omp_declare_mapper_ns; + +/* Conceptually similar to c-omp.cc:c_omp_find_nested_mappers, but using + Fortran typespec to idenfify mappers. */ + +static void +gfc_find_nested_mappers (omp_mapper_list *mlist, + gfc_omp_udm *udm) +{ + gfc_omp_namelist *ns = udm->clauses->lists[OMP_LIST_MAP]; + + for (; ns; ns = ns->next) + { + if (ns->u2.udm && ns->u2.udm->udm != udm) + { + gfc_omp_udm *nested_udm = ns->u2.udm->udm; + tree mapper_id + = (nested_udm->mapper_id ? get_identifier (nested_udm->mapper_id) + : NULL_TREE); + mlist->add_mapper (mapper_id, &nested_udm->ts, + nested_udm->backend_decl); + gfc_find_nested_mappers (mlist, nested_udm); + } + } +} + +/* Expr callback for gfc_code_walker. */ + +static int +gfc_record_mapper_bindings_expr_fn (gfc_expr **exprp, int *, void *data) +{ + gfc_typespec *ts = NULL; + omp_mapper_list *mlist + = (omp_mapper_list *) data; + + if ((*exprp)->symtree) + { + gfc_symbol *sym = (*exprp)->symtree->n.sym; + if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS) + ts = &sym->ts; + } + else if ((*exprp)->base_expr) + { + gfc_expr *base_expr = (*exprp)->base_expr; + if (base_expr->ts.type == BT_DERIVED || base_expr->ts.type == BT_CLASS) + ts = &base_expr->ts; + } + + if (!ts) + return 0; + + gfc_omp_udm *udm = gfc_find_omp_udm (omp_declare_mapper_ns, "", ts); + + if (udm) + { + mlist->add_mapper (NULL_TREE, &udm->ts, udm->backend_decl); + gfc_find_nested_mappers (mlist, udm); + } + + return 0; +} + +static void +gfc_record_mapper_bindings (tree *clauses, gfc_code *code) +{ + hash_set> seen_types; + auto_vec mappers; + omp_mapper_list mlist (&seen_types, &mappers); + + gfc_code_walker (&code, gfc_record_mapper_bindings_code_fn, + gfc_record_mapper_bindings_expr_fn, (void *) &mlist); + + unsigned int i; + tree mapperfn; + FOR_EACH_VEC_ELT (mappers, i, mapperfn) + { + tree mapper = gfc_omp_extract_mapper_directive (mapperfn); + if (mapper == error_mark_node) + continue; + tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper); + tree decl = OMP_DECLARE_MAPPER_DECL (mapper); + + if (mapper_name && IDENTIFIER_POINTER (mapper_name)[0] == '\0') + mapper_name = NULL_TREE; + + tree c = build_omp_clause (input_location, OMP_CLAUSE__MAPPER_BINDING_); + OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name; + OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl; + OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapperfn; + + OMP_CLAUSE_CHAIN (c) = *clauses; + *clauses = c; + } +} + static tree gfc_trans_omp_target (gfc_code *code) { @@ -7578,14 +7937,18 @@ gfc_trans_omp_target (gfc_code *code) gfc_start_block (&block); gfc_split_omp_clauses (code, clausesa); if (flag_openmp) - omp_clauses - = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET], - code->loc); + { + gfc_omp_clauses *target_clauses = &clausesa[GFC_OMP_SPLIT_TARGET]; + gfc_omp_instantiate_mappers (code, target_clauses); + omp_clauses = gfc_trans_omp_clauses (&block, target_clauses, + code->loc); + } switch (code->op) { case EXEC_OMP_TARGET: pushlevel (); stmt = gfc_trans_omp_code (code->block->next, true); + gfc_record_mapper_bindings (&omp_clauses, code->block->next); stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); break; case EXEC_OMP_TARGET_PARALLEL: @@ -7598,6 +7961,7 @@ gfc_trans_omp_target (gfc_code *code) = gfc_trans_omp_clauses (&iblock, &clausesa[GFC_OMP_SPLIT_PARALLEL], code->loc); stmt = gfc_trans_omp_code (code->block->next, true); + gfc_record_mapper_bindings (&omp_clauses, code->block->next); stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, inner_clauses); gfc_add_expr_to_block (&iblock, stmt); @@ -7855,8 +8219,9 @@ gfc_trans_omp_target_data (gfc_code *code) tree stmt, omp_clauses; gfc_start_block (&block); - omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, - code->loc); + gfc_omp_clauses *target_data_clauses = code->ext.omp_clauses; + gfc_omp_instantiate_mappers (code, target_data_clauses); + omp_clauses = gfc_trans_omp_clauses (&block, target_data_clauses, code->loc); stmt = gfc_trans_omp_code (code->block->next, true); stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA, void_type_node, stmt, omp_clauses); @@ -7871,7 +8236,9 @@ gfc_trans_omp_target_enter_data (gfc_code *code) tree stmt, omp_clauses; gfc_start_block (&block); - omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + gfc_omp_clauses *target_enter_data_clauses = code->ext.omp_clauses; + gfc_omp_instantiate_mappers (code, target_enter_data_clauses); + omp_clauses = gfc_trans_omp_clauses (&block, target_enter_data_clauses, code->loc); stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node, omp_clauses); @@ -7886,7 +8253,10 @@ gfc_trans_omp_target_exit_data (gfc_code *code) tree stmt, omp_clauses; gfc_start_block (&block); - omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + gfc_omp_clauses *target_exit_data_clauses = code->ext.omp_clauses; + gfc_omp_instantiate_mappers (code, target_exit_data_clauses, + TOC_OPENMP_EXIT_DATA); + omp_clauses = gfc_trans_omp_clauses (&block, target_exit_data_clauses, code->loc, TOC_OPENMP_EXIT_DATA); stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node, omp_clauses); @@ -8476,3 +8846,112 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns) } } } + +static tree +gfc_trans_omp_mapper_name (const char *mapper_id, gfc_typespec *ts) +{ + /* Enough space for ":CLASS()" + '\0'. */ + char buffer[2 * GFC_MAX_SYMBOL_LEN + 9]; + const char *type_name = gfc_typename (ts); + if (!mapper_id) + mapper_id = "default"; + snprintf (buffer, sizeof (buffer), "omp declare mapper %s:%s", mapper_id, + type_name); + return get_identifier (buffer); +} + +/* Translate our internal representation of an uninstantiated OpenMP + "declare mapper" into a form that can be consumed by the middle-end. */ + +static void +gfc_trans_omp_declare_mapper (gfc_omp_udm *udm) +{ + tree mapper_name = gfc_trans_omp_mapper_name (udm->mapper_id, &udm->ts); + tree fn; + tree saved_fn_decl = current_function_decl; + tree decl, decls; + + if (saved_fn_decl) + push_function_context (); + + tree tmp = build_function_type_list (void_type_node, NULL_TREE); + fn = build_decl (input_location, FUNCTION_DECL, mapper_name, tmp); + + DECL_ARTIFICIAL (fn) = 1; + DECL_EXTERNAL (fn) = 1; + DECL_DECLARED_INLINE_P (fn) = 1; + DECL_IGNORED_P (fn) = 1; + SET_DECL_ASSEMBLER_NAME (fn, get_identifier ("")); + DECL_ATTRIBUTES (fn) + = tree_cons (get_identifier ("gnu_inline"), NULL_TREE, + DECL_ATTRIBUTES (fn)); + + decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node); + DECL_ARTIFICIAL (decl) = 1; + DECL_IGNORED_P (decl) = 1; + DECL_CONTEXT (decl) = fn; + DECL_RESULT (fn) = decl; + + pushdecl (fn); + current_function_decl = fn; + + allocate_struct_function (fn, false); + + pushlevel (); + + stmtblock_t block; + gfc_init_block (&block); + + tree mapper_id = udm->mapper_id ? get_identifier (udm->mapper_id) : NULL_TREE; + tree type = gfc_typenode_for_spec (&udm->ts); + tree var = gfc_get_symbol_decl (udm->var_sym); + + DECL_CONTEXT (var) = fn; + /* Normally a "use"-related variable will get the DECL_EXTERN flag set, but + we don't want that here because it interferes with rewriting the decl. */ + DECL_EXTERNAL (var) = 0; + + tree maplist = gfc_trans_omp_clauses (&block, udm->clauses, udm->where, + TOC_OPENMP_DECLARE_MAPPER); + + tree stmt = make_node (OMP_DECLARE_MAPPER); + TREE_TYPE (stmt) = type; + OMP_DECLARE_MAPPER_ID (stmt) = mapper_id; + OMP_DECLARE_MAPPER_DECL (stmt) = var; + OMP_DECLARE_MAPPER_CLAUSES (stmt) = maplist; + + gfc_add_expr_to_block (&block, stmt); + DECL_SAVED_TREE (fn) = gfc_finish_block (&block); + decls = getdecls (); + poplevel (1, 1); + BLOCK_SUPERCONTEXT (DECL_INITIAL (fn)) = fn; + + DECL_SAVED_TREE (fn) = fold_build3_loc (input_location, BIND_EXPR, + void_type_node, decls, + DECL_SAVED_TREE (fn), + DECL_INITIAL (fn)); + dump_function (TDI_original, fn); + + udm->backend_decl = fn; + + set_cfun (NULL); + + if (saved_fn_decl) + { + pop_function_context (); + current_function_decl = saved_fn_decl; + } +} + +void +gfc_trans_omp_declare_mappers (gfc_symtree *omp_udm_root) +{ + if (!omp_udm_root) + return; + + gfc_trans_omp_declare_mappers (omp_udm_root->left); + gfc_trans_omp_declare_mappers (omp_udm_root->right); + + for (gfc_omp_udm *udm = omp_udm_root->n.omp_udm; udm; udm = udm->next) + gfc_trans_omp_declare_mapper (udm); +} diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 101a0540ef49..829590800873 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -71,6 +71,7 @@ tree gfc_trans_deallocate (gfc_code *); tree gfc_trans_omp_directive (gfc_code *); void gfc_trans_omp_declare_simd (gfc_namespace *); void gfc_trans_omp_declare_variant (gfc_namespace *); +void gfc_trans_omp_declare_mappers (gfc_symtree *); tree gfc_trans_oacc_directive (gfc_code *); tree gfc_trans_oacc_declare (gfc_namespace *); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 109d76472354..b0dfe0e9df19 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -831,6 +831,9 @@ tree gfc_omp_clause_assign_op (tree, tree, tree); tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); void gfc_omp_finish_clause (tree, gimple_seq *, bool); +tree gfc_omp_finish_mapper_clauses (tree); +tree gfc_omp_extract_mapper_directive (tree); +tree gfc_omp_map_array_section (location_t, tree); bool gfc_omp_allocatable_p (tree); bool gfc_omp_scalar_p (tree, bool); bool gfc_omp_scalar_target_p (tree); diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 51bb64707f0b..8214efeed275 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -69,6 +69,7 @@ along with GCC; see the file COPYING3. If not see #include "omp-offload.h" #include "context.h" #include "tree-nested.h" +#include "dwarf2out.h" /* Hash set of poisoned variables in a bind expr. */ static hash_set *asan_poisoned_variables = NULL; @@ -8900,6 +8901,26 @@ omp_map_clause_descriptor_p (tree c) return false; } +/* Try to find a (Fortran) array descriptor given a data pointer PTR, i.e. + return "foo.descr" from "foo.descr.data". */ + +static tree +omp_maybe_get_descriptor_from_ptr (tree ptr) +{ + struct array_descr_info info; + + if (TREE_CODE (ptr) != COMPONENT_REF) + return NULL_TREE; + + ptr = TREE_OPERAND (ptr, 0); + + if (lang_hooks.types.get_array_descr_info + && lang_hooks.types.get_array_descr_info (TREE_TYPE (ptr), &info)) + return ptr; + + return NULL_TREE; +} + /* For a set of mappings describing an array section pointed to by a struct (or derived type, etc.) component, create an "alloc" or "release" node to insert into a list following a GOMP_MAP_STRUCT node. For some types of @@ -8921,14 +8942,22 @@ static tree build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end, tree *extra_node) { + tree descr = omp_maybe_get_descriptor_from_ptr (OMP_CLAUSE_DECL (grp_end)); enum gomp_map_kind mkind = (code == OMP_TARGET_EXIT_DATA || code == OACC_EXIT_DATA) - ? GOMP_MAP_RELEASE : GOMP_MAP_ALLOC; + ? GOMP_MAP_RELEASE : descr ? GOMP_MAP_ALWAYS_TO : GOMP_MAP_ALLOC; gcc_assert (grp_start != grp_end); tree c2 = build_omp_clause (OMP_CLAUSE_LOCATION (grp_end), OMP_CLAUSE_MAP); OMP_CLAUSE_SET_MAP_KIND (c2, mkind); + if (descr) + { + OMP_CLAUSE_DECL (c2) = unshare_expr (descr); + OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (TREE_TYPE (descr)); + *extra_node = NULL_TREE; + return c2; + } OMP_CLAUSE_DECL (c2) = unshare_expr (OMP_CLAUSE_DECL (grp_end)); OMP_CLAUSE_CHAIN (c2) = NULL_TREE; tree grp_mid = NULL_TREE; @@ -11724,6 +11753,60 @@ omp_mapper_copy_decl (tree var, copy_body_data *cb) return var; } +/* If we have a TREE_LIST representing an unprocessed mapping group (e.g. from + a "declare mapper" definition emitted by the Fortran FE), return the node + for the data being mapped. */ + +static tree +omp_mapping_group_data (tree group) +{ + gcc_assert (TREE_CODE (group) == TREE_LIST); + /* Use the first member of the group for substitution. */ + return TREE_PURPOSE (group); +} + +/* Return the final node of a mapping_group GROUP (represented as a tree list), + or NULL_TREE if it's not an attach_detach node. */ + +static tree +omp_mapping_group_ptr (tree group) +{ + gcc_assert (TREE_CODE (group) == TREE_LIST); + + while (TREE_CHAIN (group)) + group = TREE_CHAIN (group); + + tree node = TREE_PURPOSE (group); + + gcc_assert (OMP_CLAUSE_CODE (node) == OMP_CLAUSE_MAP); + + if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_ATTACH_DETACH) + return node; + + return NULL_TREE; +} + +/* Return the pointer set (GOMP_MAP_TO_PSET) of a mapping_group node GROUP, + represented by a tree list, or NULL_TREE if there isn't one. */ + +static tree +omp_mapping_group_pset (tree group) +{ + gcc_assert (TREE_CODE (group) == TREE_LIST); + + if (!TREE_CHAIN (group)) + return NULL_TREE; + + group = TREE_CHAIN (group); + + tree node = TREE_PURPOSE (group); + + if (omp_map_clause_descriptor_p (node)) + return node; + + return NULL_TREE; +} + static tree * omp_instantiate_mapper (gimple_seq *pre_p, hash_map, tree> *implicit_mappers, @@ -11743,8 +11826,138 @@ omp_instantiate_mapper (gimple_seq *pre_p, "bind" expression in the pre_p sequence). */ hash_map extraction_map; - extraction_map.put (dummy_var, expr); - extraction_map.put (expr, expr); + if (TREE_CODE (mapperfn) == FUNCTION_DECL + && TREE_CODE (DECL_SAVED_TREE (mapperfn)) == BIND_EXPR) + { + tree body = NULL_TREE, bind = DECL_SAVED_TREE (mapperfn); + copy_body_data id; + hash_map decl_map; + + /* The "decl map" maps declarations in the definition of the mapper + function into new declarations in the current function. These are + local to the bind in which they are expanded, so we copy them out to + temporaries in the enclosing function scope, and use those temporaries + in the mapper expansion (see "extraction_map" above). (This also + allows a mapper to be invoked for multiple variables). */ + + memset (&id, 0, sizeof (id)); + /* The source function isn't always mapperfn: e.g. for C++ mappers + defined within functions, the mapper decl is created in a scope + within that function, rather than in mapperfn. So, that containing + function is the one we need to copy from. */ + id.src_fn = DECL_CONTEXT (dummy_var); + id.dst_fn = current_function_decl; + id.src_cfun = DECL_STRUCT_FUNCTION (mapperfn); + id.decl_map = &decl_map; + id.copy_decl = copy_decl_no_change; + id.transform_call_graph_edges = CB_CGE_DUPLICATE; + id.transform_new_cfg = true; + + walk_tree (&bind, copy_tree_body_r, &id, NULL); + + body = BIND_EXPR_BODY (bind); + + extraction_map.put (dummy_var, expr); + extraction_map.put (expr, expr); + + if (DECL_P (expr)) + mark_addressable (expr); + + tree dummy_var_remapped, *remapped_var_p = decl_map.get (dummy_var); + if (remapped_var_p) + dummy_var_remapped = *remapped_var_p; + else + internal_error ("failed to remap mapper variable"); + + hash_map mapper_map; + mapper_map.put (dummy_var_remapped, expr); + + /* Now we need to make two adjustments to the inlined bind: we have to + substitute the dummy variable for the expression in the clause + triggering this mapper instantiation, and we need to remove the + (remapped) decl from the bind's decl list. */ + + if (TREE_CODE (body) == STATEMENT_LIST) + { + copy_body_data id2; + memset (&id2, 0, sizeof (id2)); + id2.src_fn = current_function_decl; + id2.dst_fn = current_function_decl; + id2.src_cfun = cfun; + id2.decl_map = &mapper_map; + id2.copy_decl = omp_mapper_copy_decl; + id2.transform_call_graph_edges = CB_CGE_DUPLICATE; + id2.transform_new_cfg = true; + + tree_stmt_iterator tsi; + for (tsi = tsi_start (body); !tsi_end_p (tsi); tsi_next (&tsi)) + { + tree* stmtp = tsi_stmt_ptr (tsi); + if (TREE_CODE (*stmtp) == OMP_DECLARE_MAPPER) + *stmtp = NULL_TREE; + else if (TREE_CODE (*stmtp) == DECL_EXPR + && DECL_EXPR_DECL (*stmtp) == dummy_var_remapped) + *stmtp = NULL_TREE; + else + walk_tree (stmtp, remap_mapper_decl_1, &id2, NULL); + } + + tsi = tsi_last (body); + + for (hash_map::iterator ti = decl_map.begin (); + ti != decl_map.end (); + ++ti) + { + tree tmp, var = (*ti).first, inlined = (*ti).second; + + if (var == dummy_var || var == inlined || !DECL_P (var)) + continue; + + if (!is_gimple_reg (var)) + { + const char *decl_name + = IDENTIFIER_POINTER (DECL_NAME (var)); + tmp = create_tmp_var (TREE_TYPE (var), decl_name); + } + else + tmp = create_tmp_var (TREE_TYPE (var)); + + /* We have three versions of the decl here. VAR is the version + as represented in the function defining the "declare mapper", + and in the clause list attached to the OMP_DECLARE_MAPPER + directive within that function. INLINED is the variable that + has been localised to a bind within the function where the + mapper is being instantiated (i.e. current_function_decl). + TMP is the variable that we copy the values created in that + block to. */ + + extraction_map.put (var, tmp); + extraction_map.put (tmp, tmp); + + tree asgn = build2 (MODIFY_EXPR, TREE_TYPE (tmp), tmp, inlined); + tsi_link_after (&tsi, asgn, TSI_CONTINUE_LINKING); + } + } + + /* We've replaced the "dummy variable" of the declare mapper definition + with a localised version in a bind expr in the current function. We + have just rewritten all references to that, so remove the decl. */ + + for (tree *decl = &BIND_EXPR_VARS (bind); *decl;) + { + if (*decl == dummy_var_remapped) + *decl = DECL_CHAIN (*decl); + else + decl = &DECL_CHAIN (*decl); + } + + gimplify_bind_expr (&bind, pre_p); + } + else + { + extraction_map.put (dummy_var, expr); + extraction_map.put (expr, expr); + } /* This copy_body_data is only used to remap the decls in the OMP_DECLARE_MAPPER tree node expansion itself. All relevant decls should @@ -11776,6 +11989,85 @@ omp_instantiate_mapper (gimple_seq *pre_p, } tree decl = OMP_CLAUSE_DECL (clause); + + if (map_kind == GOMP_MAP_MAPPING_GROUP) + { + tree data = omp_mapping_group_data (decl); + tree group_type = TREE_TYPE (OMP_CLAUSE_DECL (data)); + + group_type = TYPE_MAIN_VARIANT (group_type); + + nested_mapper_p = implicit_mappers->get ({ mapper_name, group_type }); + + if (nested_mapper_p && *nested_mapper_p != mapperfn) + { + tree unshared = unshare_expr (data); + map_kind = OMP_CLAUSE_MAP_KIND (data); + walk_tree (&unshared, remap_mapper_decl_1, &id, NULL); + tree ptr = omp_mapping_group_ptr (decl); + + /* !!! When ptr is NULL, we're discarding the other nodes in the + mapping group. Is that always OK? */ + + if (ptr) + { + /* This behaviour is Fortran-specific. That's fine for now + because only Fortran is using GOMP_MAP_MAPPING_GROUP, but + may need revisiting if that ever changes. */ + gcc_assert (lang_GNU_Fortran ()); + + /* We're invoking a (nested) mapper from CLAUSE, which was a + pointer to a derived type. The elements of the derived + type are handled by the mapper, but we need to map the + actual pointer as well. Create an ALLOC node to do + that. + If we have an array descriptor, we want to copy it to the + target, so instead use an ALWAYS_TO mapping and copy the + descriptor itself rather than the data pointer. */ + + tree pset = omp_mapping_group_pset (decl); + tree ptr_unshared = unshare_expr (pset ? pset : ptr); + walk_tree (&ptr_unshared, remap_mapper_decl_1, &id, NULL); + + tree node = build_omp_clause (OMP_CLAUSE_LOCATION (clause), + OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (node, pset ? GOMP_MAP_ALWAYS_TO + : GOMP_MAP_ALLOC); + OMP_CLAUSE_DECL (node) = OMP_CLAUSE_DECL (ptr_unshared); + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (OMP_CLAUSE_DECL (node))); + + *mapper_clauses_p = node; + mapper_clauses_p = &OMP_CLAUSE_CHAIN (node); + } + + if (map_kind == GOMP_MAP_UNSET) + map_kind = outer_kind; + + mapper_clauses_p + = omp_instantiate_mapper (pre_p, implicit_mappers, + *nested_mapper_p, + OMP_CLAUSE_DECL (unshared), map_kind, + mapper_clauses_p); + } + else + /* No nested mapper, so process each element of the mapping + group. */ + for (tree cp = OMP_CLAUSE_DECL (clause); cp; cp = TREE_CHAIN (cp)) + { + tree node = unshare_expr (TREE_PURPOSE (cp)); + walk_tree (&node, remap_mapper_decl_1, &id, NULL); + + if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_UNSET) + OMP_CLAUSE_SET_MAP_KIND (node, outer_kind); + + *mapper_clauses_p = node; + mapper_clauses_p = &OMP_CLAUSE_CHAIN (node); + } + + continue; + } + tree unshared, type; bool nonunit_array_with_mapper = false; diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 new file mode 100644 index 000000000000..7bf30df9cdbd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 @@ -0,0 +1,71 @@ +! { dg-do compile } + +! Basic "!$omp declare mapper" parsing tests. + +module mymod +type s + integer :: c + integer :: d(99) + integer, dimension(100,100) :: e +end type s + +!$omp declare mapper (s :: x) map(tofrom: x%c, x%d) +!$omp declare mapper (withaname : s :: x) map(from: x%d(2:30)) +!$omp declare mapper (withaname2 : s :: x) map(from: x%d(5)) +!$omp declare mapper (named: s :: x) map(tofrom: x%e(:,3)) +!$omp declare mapper (named2: s :: x) map(tofrom: x%e(5,:)) + +end module mymod + +program myprog +use mymod, only: s +type t + integer :: a + integer :: b +end type t + +type u + integer :: q +end type u + +type deriv + integer :: arr(100) + integer :: len +end type deriv + +type(t) :: y +type(s) :: z +type(u) :: p +type(deriv) :: d +integer, dimension(100,100) :: i2d + +!$omp declare mapper (t :: x) map(tofrom: x%a) map(y%b) +!$omp declare mapper (named: t :: x) map(tofrom: x%a) map(y%b) +!$omp declare mapper (integer :: x) ! { dg-error "\\\!\\\$OMP DECLARE MAPPER with non-derived type" } + +!$omp declare mapper (deriv :: x) map(tofrom: x%len) & +!$omp & map(tofrom: x%arr(:)) + +!$omp target map(tofrom: z%e(:,5)) +!$omp end target + +!$omp target map(mapper(named), tofrom: y) +!$omp end target + +!$omp target +y%a = y%b +!$omp end target + +d%len = 10 + +!$omp target +d%arr(5) = 13 +!$omp end target + +!$omp target map(tofrom: z) +!$omp end target + +!$omp target map(mapper(withaname), from: z) map(tofrom:p%q) +!$omp end target + +end program myprog diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90 new file mode 100644 index 000000000000..8ae73935a2d5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90 @@ -0,0 +1,26 @@ +program myprog +type T +integer :: arr1(10) +integer :: arr2(10) +end type T + +type U +integer :: arr1(10) +end type U + +type V +integer :: arr1(10) +end type V + +!$omp declare mapper (default: T :: x) map(to:x%arr1) map(from:x%arr2) ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER" } +!$omp declare mapper (T :: x) map(to:x%arr1) ! { dg-error "Redefinition of \\\!\\\$OMP DECLARE MAPPER" } + +! Check what happens if we're SHOUTING too. +!$omp declare mapper (default: U :: x) map(to:x%arr1) ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER" } +!$omp declare mapper (DEFAULT: U :: x) map(to:x%arr1) ! { dg-error "Redefinition of \\\!\\\$OMP DECLARE MAPPER" } + +! Or if we're using a keyword (which should be fine). +!$omp declare mapper (V :: x) map(alloc:x%arr1) +!$omp declare mapper (integer : V :: x) map(tofrom:x%arr1(:)) + +end program myprog diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22-p.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22-p.f90 new file mode 100644 index 000000000000..5ffa381cf188 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22-p.f90 @@ -0,0 +1,61 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +type t +integer, pointer :: arrcomp(:) +integer :: b, c, d +end type t + +type(t) :: myvar +integer, target :: tgtarr(1:100) + +!$omp declare mapper (t :: x) map(to: x%arrcomp) map(alloc: x%b) & +!$omp & map(from: x%c) map(tofrom: x%d) + +myvar%arrcomp => tgtarr + +!$omp target enter data map(to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: 4\]\) map\(to:myvar\.d \[len: [0-9]+\]\) map\(to:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(from:myvar\.c \[len: [0-9]+\]\) map\(from:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(alloc: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\) map\(alloc:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(release: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(release:myvar\.c \[len: [0-9]+\]\) map\(release:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(present, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(force_present:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\) map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp target exit data map(present, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(always, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(always,to:myvar\.d \[len: [0-9]+\]\) map\(always,to:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(always, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,from:myvar\.c \[len: [0-9]+\]\) map\(always,from:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(always, present, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(always,present,to:myvar\.d \[len: [0-9]+\]\) map\(always,present,to:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(always, present, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,present,from:myvar\.c \[len: [0-9]+\]\) map\(always,present,from:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 new file mode 100644 index 000000000000..999e677d2ae0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 @@ -0,0 +1,63 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } +! FIXME: Since this test has scan-tree-dump-times checks, it's easier to just +! skip it until the 'allocatable' component mapping support is done. +! { dg-skip-if "missing 'allocatable' component mapping support" { *-*-* } } + +type t +integer, allocatable :: arrcomp(:) +integer :: b, c, d +end type t + +type(t) :: myvar + +!$omp declare mapper (t :: x) map(to: x%arrcomp) map(alloc: x%b) & +!$omp & map(from: x%c) map(tofrom: x%d) + +allocate (myvar%arrcomp(1:100)) + +!$omp target enter data map(to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: 4\]\) map\(to:myvar\.d \[len: [0-9]+\]\) map\(to:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(from:myvar\.c \[len: [0-9]+\]\) map\(from:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(alloc: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\) map\(alloc:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(release: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(release:myvar\.c \[len: [0-9]+\]\) map\(release:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(present, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(force_present:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\) map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp target exit data map(present, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(always, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(always,to:myvar\.d \[len: [0-9]+\]\) map\(always,to:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(always, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,from:myvar\.c \[len: [0-9]+\]\) map\(always,from:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + + +!$omp target enter data map(always, present, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(always,present,to:myvar\.d \[len: [0-9]+\]\) map\(always,present,to:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(always, present, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,present,from:myvar\.c \[len: [0-9]+\]\) map\(always,present,from:myvar\.d \[len: [0-9]+\]\) map\(release:myvar\.arrcomp \[len: [0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\) map\(release:MEM \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\)} 1 "gimple" } } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 new file mode 100644 index 000000000000..6c07261040d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +type t +integer :: a, b, c, d +end type t + +type(t) :: myvar + +!$omp declare mapper (t :: x) map(to: x%a) map(alloc: x%b) & +!$omp & map(from: x%c) map(tofrom: x%d) + +!$omp target data map(to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.a \[len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(to:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp end target data + +!$omp target data map(alloc: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(alloc:myvar\.a \[len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp end target data + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26-p.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26-p.f90 new file mode 100644 index 000000000000..705decea0fa3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26-p.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } + +type t +integer, pointer :: arr(:) +end type t + +!$omp declare mapper(even: T :: tv) map(tv%arr(2::2)) + +type(t) :: var +integer, target :: tgtarr(100) + +var%arr => tgtarr + +var%arr = 0 + +! You can't do this, the mapper specifies a noncontiguous access. +!$omp target enter data map(mapper(even), to: var) +! { dg-error {Stride should not be specified for array section in MAP clause} "" { target *-*-* } .-1 } + +var%arr = 1 + +! But this is fine. (Re-enabled by a later patch.) +!!$omp target update to(mapper(even): var) + +! As 'enter data'. +!$omp target exit data map(mapper(even), delete: var) +! { dg-error {Stride should not be specified for array section in MAP clause} "" { target *-*-* } .-1 } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 new file mode 100644 index 000000000000..be5605ce8b7b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } + +type t +integer, allocatable :: arr(:) +end type t + +!$omp declare mapper(even: T :: tv) map(tv%arr(2::2)) +! { dg-error "List item 'tv' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } + +type(t) :: var + +allocate(var%arr(100)) + +var%arr = 0 + +! When 'allocatable' component mapping is complete, only the stride errors +! should be raised below. + +! You can't do this, the mapper specifies a noncontiguous access. +!$omp target enter data map(mapper(even), to: var) +! { dg-error {Stride should not be specified for array section in MAP clause} "" { xfail *-*-* } .-1 } +! { dg-error "List item 'var' with allocatable components is not permitted in map clause" "" { target *-*-* } .-2 } + +var%arr = 1 + +! But this is fine. (Re-enabled by later patch.) +!!$omp target update to(mapper(even): var) + +! As 'enter data'. +!$omp target exit data map(mapper(even), delete: var) +! { dg-error {Stride should not be specified for array section in MAP clause} "" { xfail *-*-* } .-1 } +! { dg-error "List item 'var' with allocatable components is not permitted in map clause" "" { target *-*-* } .-2 } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90 new file mode 100644 index 000000000000..e2039e80e579 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } + +! Check duplicate clause detection after mapper expansion. + +type t +integer :: x +end type t + +real(4) :: unrelated +type(t) :: tvar + +!$omp declare mapper (t :: var) map(unrelated) map(var%x) + +tvar%x = 0 +unrelated = 5 + +!$omp target firstprivate(unrelated) map(tofrom: tvar) +! { dg-error "Symbol .unrelated. present on both data and map clauses" "" { target *-*-* } .-1 } +tvar%x = unrelated +!$omp end target + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31-p.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31-p.f90 new file mode 100644 index 000000000000..b62c8255de5f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31-p.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } + +type t +integer :: x, y +integer, pointer :: arr(:) +end type t + +type(t) :: var +integer, target :: tgtarr(20) + +var%arr => tgtarr + +var%arr = 0 + +! If we ask for a named mapper that hasn't been defined, an error should be +! raised. This isn't a *syntax* error, so the !$omp target..!$omp end target +! block should still be parsed correctly. +!$omp target map(mapper(arraymapper), tofrom: var) +! { dg-error "User-defined mapper .arraymapper. not found" "" { target *-*-* } .-1 } +var%arr(5) = 5 +!$omp end target + +! OTOH, this is a syntax error, and the offload block is not recognized. +!$omp target map( +! { dg-error "Syntax error in OpenMP variable list" "" { target *-*-* } .-1 } +var%arr(6) = 6 +!$omp end target +! { dg-error "Unexpected !.OMP END TARGET statement" "" { target *-*-* } .-1 } + +! ...but not for the specific name 'default'. +!$omp target map(mapper(default), tofrom: var) +var%arr(5) = 5 +!$omp end target + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 new file mode 100644 index 000000000000..8e86a185212c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } + +type t +integer :: x, y +integer, allocatable :: arr(:) +end type t + +type(t) :: var + +allocate(var%arr(1:20)) + +var%arr = 0 + +! If we ask for a named mapper that hasn't been defined, an error should be +! raised. This isn't a *syntax* error, so the !$omp target..!$omp end target +! block should still be parsed correctly. +!$omp target map(mapper(arraymapper), tofrom: var) +! { dg-error "User-defined mapper .arraymapper. not found" "" { target *-*-* } .-1 } +! { dg-error "List item 'var' with allocatable components is not permitted in map clause" "" { target *-*-* } .-2 } +var%arr(5) = 5 +!$omp end target + +! OTOH, this is a syntax error, and the offload block is not recognized. +!$omp target map( +! { dg-error "Syntax error in OpenMP variable list" "" { target *-*-* } .-1 } +var%arr(6) = 6 +!$omp end target +! { dg-error "Unexpected !.OMP END TARGET statement" "" { target *-*-* } .-1 } + +! ...but not for the specific name 'default'. +!$omp target map(mapper(default), tofrom: var) +! { dg-error "List item 'var' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } +var%arr(5) = 5 +!$omp end target + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 new file mode 100644 index 000000000000..0790fcd35088 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } + +! Check duplicate mapper detection in module reader. + +module mod1 +type S +integer, dimension(:), pointer :: arr +end type S +!$omp declare mapper (S :: v) map(to: v%arr) map(tofrom:v%arr(1)) +end module mod1 + +module mod2 +type S +character :: c +integer, dimension(:), pointer :: arr +end type S +!$omp declare mapper (S :: v) map(to: v%arr) map(tofrom:v%arr(:)) + +type(S) :: svar + +contains + +subroutine setup +allocate(svar%arr(10)) +end subroutine setup + +subroutine teardown +deallocate(svar%arr) +end subroutine teardown + +end module mod2 + +program myprog +use mod1 ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER from module mod1" } +use mod2 ! { dg-error "Ambiguous \\\!\\\$OMP DECLARE MAPPER from module mod2" } + +call setup + +!$omp target +svar%arr(1) = svar%arr(1) + 1 +!$omp end target + +call teardown + +end program myprog diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index 51aca38638af..b3c8aa49537c 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -1024,6 +1024,9 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case GOMP_MAP_POP_MAPPER_NAME: pp_string (pp, "pop_mapper"); break; + case GOMP_MAP_MAPPING_GROUP: + pp_string (pp, "mapping_group"); + break; default: gcc_unreachable (); } diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 4d9ebdbe9f79..7903edf42985 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -215,7 +215,10 @@ enum gomp_map_kind GOMP_MAP_UNSET = (GOMP_MAP_LAST | 8), /* Used to record the name of a named mapper. */ GOMP_MAP_PUSH_MAPPER_NAME = (GOMP_MAP_LAST | 9), - GOMP_MAP_POP_MAPPER_NAME = (GOMP_MAP_LAST | 10) + GOMP_MAP_POP_MAPPER_NAME = (GOMP_MAP_LAST | 10), + /* Used to hold a TREE_LIST of grouped nodes in an 'omp declare mapper' + definition (only for Fortran at present). */ + GOMP_MAP_MAPPING_GROUP = (GOMP_MAP_LAST | 11) }; #define GOMP_MAP_COPY_TO_P(X) \ diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90 new file mode 100644 index 000000000000..801becc7d7dc --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90 @@ -0,0 +1,40 @@ +! { dg-do run } + +program myprog +type t + integer, dimension (8) :: arr1 +end type t +type u + type(t), dimension (:), pointer :: tarr +end type u + +type(u) :: myu +type(t), dimension (12), target :: myarray + +!$omp declare mapper (t :: x) map(x%arr1(1:4)) +!$omp declare mapper (u :: x) map(to: x%tarr) map(x%tarr(1)) + +myu%tarr => myarray + +myu%tarr(1)%arr1(1) = 1 + +! We can't do this: we have a mapper for "t" elements, and this implicitly maps +! the whole array. +!!$omp target map(tofrom:myu%tarr) +!myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1 +!!$omp end target + +! ...but we can do this, because we're just mapping an element of the "t" +! array. We still need to map the actual "myu%tarr" descriptor. +!$omp target map(to:myu%tarr) map(myu%tarr(1)%arr1(1:4)) +myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1 +!$omp end target + +!$omp target +myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1 +!$omp end target + +if (myu%tarr(1)%arr1(1).ne.3) stop 1 + +end program myprog + diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90 new file mode 100644 index 000000000000..0fc424a7ba48 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90 @@ -0,0 +1,38 @@ +! { dg-do run } + +program myprog +type t + integer, dimension (8) :: arr1 +end type t +type u + type(t) :: t_elem +end type u + +type(u) :: myu + +!$omp declare mapper (t :: x) map(x%arr1(5:8)) +!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4)) +!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem) + +myu%t_elem%arr1(1) = 1 +myu%t_elem%arr1(5) = 1 + +! Different ways of invoking nested mappers, named vs. unnamed + +!$omp target map(tofrom:myu%t_elem) +myu%t_elem%arr1(5) = myu%t_elem%arr1(5) + 1 +!$omp end target + +!$omp target map(tofrom:myu) +myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1 +!$omp end target + +!$omp target +myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1 +!$omp end target + +if (myu%t_elem%arr1(1).ne.3) stop 1 +if (myu%t_elem%arr1(5).ne.2) stop 2 + +end program myprog + diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90 new file mode 100644 index 000000000000..a475501d014f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90 @@ -0,0 +1,33 @@ +! { dg-do run } + +program myprog +type t + integer, dimension (8) :: arr1 +end type t +type u + type(t) :: t_elem +end type u + +type(u) :: myu + +!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4)) +!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem) + +myu%t_elem%arr1(1) = 1 + +!$omp target map(tofrom:myu%t_elem) +myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1 +!$omp end target + +!$omp target map(tofrom:myu) +myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1 +!$omp end target + +!$omp target +myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1 +!$omp end target + +if (myu%t_elem%arr1(1).ne.4) stop 1 + +end program myprog + diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90 new file mode 100644 index 000000000000..3cae0fe7c265 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90 @@ -0,0 +1,49 @@ +! { dg-do run } + +module mymod +type S +integer :: a +integer :: b +integer :: c +end type S + +!$omp declare mapper (S :: x) map(x%c) +end module mymod + +program myprog +use mymod +type T +integer :: a +integer :: b +integer :: c +end type T + +type(S) :: mys +type(T) :: myt + +!$omp declare mapper (T :: x) map(x%b) + +myt%a = 0 +myt%b = 0 +myt%c = 0 +mys%a = 0 +mys%b = 0 +mys%c = 0 + +!$omp target +myt%b = myt%b + 1 +!$omp end target + +!$omp target +mys%c = mys%c + 1 +!$omp end target + +!$omp target +myt%b = myt%b + 2 +mys%c = mys%c + 3 +!$omp end target + +if (myt%b.ne.3) stop 1 +if (mys%c.ne.4) stop 2 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90 new file mode 100644 index 000000000000..eb0dd5f1027f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90 @@ -0,0 +1,24 @@ +! { dg-do run } + +program myprog + +type A +character(len=20) :: string1 +character(len=:), pointer :: string2 +end type A + +!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2) + +type(A) :: var + +allocate(character(len=20) :: var%string2) + +var%string1 = "hello world" + +!$omp target map(to:var%string1) map(from:var%string2) +var%string2 = var%string1 +!$omp end target + +if (var%string2.ne."hello world") stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90 new file mode 100644 index 000000000000..c21597145dd1 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90 @@ -0,0 +1,92 @@ +! { dg-do run } + +program myprog + +type A +integer :: x +integer :: y(20) +integer, dimension(:), pointer :: z +end type A + +integer, target :: arr1(20), arr2(20) +type(A) :: p, q + +p%y = 0 +q%y = 0 + +p%z => arr1 +q%z => arr2 + +call mysub (p, q) + +if (p%z(1).ne.1) stop 1 +if (q%z(1).ne.1) stop 2 + +p%y = 0 +q%y = 0 +p%z = 0 +q%z = 0 + +call mysub2 (p, q) + +if (p%z(1).ne.1) stop 3 +if (q%z(1).ne.1) stop 4 + +p%y = 0 +q%y = 0 +p%z = 0 +q%z = 0 + +call mysub3 (p, q) + +if (p%z(1).ne.1) stop 5 +if (q%z(1).ne.1) stop 6 + +contains + +subroutine mysub(arg1, arg2) +implicit none +type(A), intent(inout) :: arg1 +type(A), intent(inout) :: arg2 + +!$omp declare mapper (A :: x) map(always, to:x) map(tofrom:x%z(:)) + +!$omp target +arg1%y(1) = arg1%y(1) + 1 +arg1%z = arg1%y +arg2%y(1) = arg2%y(1) + 1 +arg2%z = arg2%y +!$omp end target +end subroutine mysub + +subroutine mysub2(arg1, arg2) +implicit none +type(A), intent(inout) :: arg1 +type(A), intent(inout) :: arg2 + +!$omp declare mapper (A :: x) map(to:x) map(from:x%z(:)) + +!$omp target +arg1%y(1) = arg1%y(1) + 1 +arg1%z = arg1%y +arg2%y(1) = arg2%y(1) + 1 +arg2%z = arg2%y +!$omp end target +end subroutine mysub2 + +subroutine mysub3(arg1, arg2) +implicit none +type(A), intent(inout) :: arg1 +type(A), intent(inout) :: arg2 + +!$omp declare mapper (A :: x) map(to:x) map(from:x%z(:)) + +!$omp target map(arg1, arg2) +arg1%y(1) = arg1%y(1) + 1 +arg1%z = arg1%y +arg2%y(1) = arg2%y(1) + 1 +arg2%z = arg2%y +!$omp end target +end subroutine mysub3 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90 new file mode 100644 index 000000000000..a333b6844f1f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90 @@ -0,0 +1,46 @@ +! { dg-do run } + +module mymod +type F +integer :: a, b, c +integer, dimension(10) :: d +end type F + +type G +integer :: x, y +type(F), pointer :: myf +integer :: z +end type G + +! Check that nested mappers work inside modules. + +!$omp declare mapper (F :: f) map(to: f%b) map(f%d) +!$omp declare mapper (G :: g) map(tofrom: g%myf) + +end module mymod + +program myprog +use mymod + +type(F), target :: ftmp +type(G) :: gvar + +gvar%myf => ftmp + +gvar%myf%d = 0 + +!$omp target map(gvar%myf) +gvar%myf%d(1) = gvar%myf%d(1) + 1 +!$omp end target + +!$omp target map(gvar) +gvar%myf%d(1) = gvar%myf%d(1) + 1 +!$omp end target + +!$omp target +gvar%myf%d(1) = gvar%myf%d(1) + 1 +!$omp end target + +if (gvar%myf%d(1).ne.3) stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90 new file mode 100644 index 000000000000..d86497524f93 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90 @@ -0,0 +1,29 @@ +! { dg-do run } + +program myprog +type F +integer :: a, b, c +integer, dimension(10) :: d +end type F + +type(F), pointer :: myf + +!$omp declare mapper (F :: f) map(f%d) + +allocate(myf) + +myf%d = 0 + +!$omp target map(myf) +myf%d(1) = myf%d(1) + 1 +!$omp end target + +!$omp target +myf%d(1) = myf%d(1) + 1 +!$omp end target + +if (myf%d(1).ne.2) stop 1 + +deallocate(myf) + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90 new file mode 100644 index 000000000000..ec1c0ec2a15a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90 @@ -0,0 +1,32 @@ +! { dg-do run } + +program myprog +type s + integer :: c + integer :: d(99) +end type s + +type t + type(s) :: mys +end type t + +type u + type(t) :: myt +end type u + +type(u) :: myu + +!$omp declare mapper (t :: x) map(tofrom: x%mys%c) map(x%mys%d(1:x%mys%c)) + +myu%myt%mys%c = 1 +myu%myt%mys%d = 0 + +!$omp target map(tofrom: myu%myt) +myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1 +myu%myt%mys%c = myu%myt%mys%c + 2 +!$omp end target + +if (myu%myt%mys%d(1).ne.1) stop 1 +if (myu%myt%mys%c.ne.3) stop 2 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90 new file mode 100644 index 000000000000..20688289ecfb --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90 @@ -0,0 +1,29 @@ +! { dg-do run } + +program myprog +type F +integer :: a, b, c +integer, dimension(10) :: d +end type F + +type(F), allocatable :: myf + +!$omp declare mapper (F :: f) map(f) + +allocate(myf) + +myf%d = 0 + +!$omp target map(myf) +myf%d(1) = myf%d(1) + 1 +!$omp end target + +!$omp target +myf%d(1) = myf%d(1) + 1 +!$omp end target + +if (myf%d(1).ne.2) stop 1 + +deallocate(myf) + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-21-p.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-21-p.f90 new file mode 100644 index 000000000000..363bc617f775 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-21-p.f90 @@ -0,0 +1,25 @@ +! { dg-do run } + +program myprog + +type A +character(len=20) :: string1 +character(len=:), pointer :: string2 +end type A + +!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2) + +type(A) :: var +character(len=20), target :: tgtstring + +var%string2 => tgtstring + +var%string1 = "hello world" + +!$omp target +var%string2 = var%string1 +!$omp end target + +if (var%string2.ne."hello world") stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90 new file mode 100644 index 000000000000..f1617bcc7201 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90 @@ -0,0 +1,26 @@ +! NOTE: Make this a run test after 'allocatable' map support is committed. +! { dg-do compile } + +program myprog + +type A +character(len=20) :: string1 +character(len=:), allocatable :: string2 +end type A + +!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2) +! { dg-error "List item 'x' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } + +type(A) :: var + +allocate(character(len=20) :: var%string2) + +var%string1 = "hello world" + +!$omp target +var%string2 = var%string1 +!$omp end target + +if (var%string2.ne."hello world") stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90 new file mode 100644 index 000000000000..517096db51c7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90 @@ -0,0 +1,33 @@ +program myprog +type s + integer :: c + integer :: d(99) +end type s + +type t + type(s) :: mys +end type t + +type u + type(t) :: myt +end type u + +type(u) :: myu + +!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c)) +!$omp declare mapper (t :: x) map(tofrom: x%mys) +!$omp declare mapper (u :: x) map(tofrom: x%myt) + +myu%myt%mys%c = 1 +myu%myt%mys%d = 0 + +! Nested mappers. + +!$omp target map(tofrom: myu) +myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1 +!$omp end target + +if (myu%myt%mys%c.ne.1) stop 1 +if (myu%myt%mys%d(1).ne.1) stop 2 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-30-p.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-30-p.f90 new file mode 100644 index 000000000000..7c3294fff9a4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-30-p.f90 @@ -0,0 +1,25 @@ +! { dg-do run } + +type t +integer :: x, y +integer, pointer :: arr(:) +end type t + +!$omp declare mapper (t :: x) map(x%arr) + +type(t) :: var +integer, target :: tgtarr(20) + +var%arr => tgtarr + +var%arr = 0 + +! The mapper named literally 'default' should be the default mapper, i.e. +! the same as the unnamed mapper defined above. +!$omp target map(mapper(default), tofrom: var) +var%arr(5) = 5 +!$omp end target + +if (var%arr(5).ne.5) stop 1 + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 new file mode 100644 index 000000000000..67e41436085a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 @@ -0,0 +1,27 @@ +! NOTE: Make this a 'run' test once allocatable component mappings are fixed. +! { dg-do compile } + +type t +integer :: x, y +integer, allocatable :: arr(:) +end type t + +!$omp declare mapper (t :: x) map(x%arr) +! { dg-error "List item 'x' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } + +type(t) :: var + +allocate(var%arr(1:20)) + +var%arr = 0 + +! The mapper named literally 'default' should be the default mapper, i.e. +! the same as the unnamed mapper defined above. +!$omp target map(mapper(default), tofrom: var) +! { dg-error "List item 'var' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } +var%arr(5) = 5 +!$omp end target + +if (var%arr(5).ne.5) stop 1 + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-4-p.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-4-p.f90 new file mode 100644 index 000000000000..2a7550a70d98 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-4-p.f90 @@ -0,0 +1,41 @@ +! { dg-do run } + +program myprog +type s + integer :: c + integer, pointer :: d(:) +end type s + +type t + type(s) :: mys +end type t + +type u + type(t) :: myt +end type u + +type(u) :: myu +integer, target :: tgtarr(20) + +! Here, the mappers are declared out of order, but earlier ones can still +! trigger mappers defined later. Implementation-wise, this happens during +! resolution, but from the user perspective it appears to happen at +! instantiation time -- at which point all mappers are visible. I think +! that makes sense. +!$omp declare mapper (u :: x) map(tofrom: x%myt) +!$omp declare mapper (t :: x) map(tofrom: x%mys) +!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c)) + +myu%myt%mys%d => tgtarr + +myu%myt%mys%c = 1 +myu%myt%mys%d = 0 + +!$omp target map(tofrom: myu) +myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1 +!$omp end target + +! Note: we only mapped the first element of the array 'd'. +if (myu%myt%mys%d(1).ne.1) stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 new file mode 100644 index 000000000000..b7584ce11413 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 @@ -0,0 +1,45 @@ +! NOTE: Make this a 'run' test once allocatable component mappings are fixed. +! { dg-do compile } + +program myprog +type s + integer :: c + integer, allocatable :: d(:) +end type s + +type t + type(s) :: mys +end type t + +type u + type(t) :: myt +end type u + +type(u) :: myu + +! Here, the mappers are declared out of order, but earlier ones can still +! trigger mappers defined later. Implementation-wise, this happens during +! resolution, but from the user perspective it appears to happen at +! instantiation time -- at which point all mappers are visible. I think +! that makes sense. +!$omp declare mapper (u :: x) map(tofrom: x%myt) +! { dg-error "List item 'x' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } +!$omp declare mapper (t :: x) map(tofrom: x%mys) +! { dg-error "List item 'x' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } +!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c)) +! { dg-error "List item 'x' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } + +allocate(myu%myt%mys%d(1:20)) + +myu%myt%mys%c = 1 +myu%myt%mys%d = 0 + +!$omp target map(tofrom: myu) +! { dg-error "List item 'myu' with allocatable components is not permitted in map clause" "" { target *-*-* } .-1 } +myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1 +!$omp end target + +! Note: we only mapped the first element of the array 'd'. +if (myu%myt%mys%d(1).ne.1) stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90 new file mode 100644 index 000000000000..9ebf8da6d8be --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90 @@ -0,0 +1,28 @@ +! { dg-do run } + +program myprog +type bounds + integer :: lo + integer :: hi +end type bounds + +integer, allocatable :: myarr(:) +type(bounds) :: b + +! Use the placeholder variable, but not at the top level. +!$omp declare mapper (bounds :: x) map(tofrom: myarr(x%lo:x%hi)) + +allocate (myarr(1:100)) + +b%lo = 4 +b%hi = 6 + +myarr = 0 + +!$omp target map(tofrom: b) +myarr(5) = myarr(5) + 1 +!$omp end target + +if (myarr(5).ne.1) stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90 new file mode 100644 index 000000000000..6297c8e99cb1 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90 @@ -0,0 +1,29 @@ +! { dg-do run } + +program myprog +type s + integer :: a + integer :: b +end type s + +type t + type(s) :: mys +end type t + +type(t) :: myt + +! Identity mapper + +!$omp declare mapper (s :: x) map(tofrom: x) +!$omp declare mapper (t :: x) map(tofrom: x%mys) + +myt%mys%a = 0 +myt%mys%b = 0 + +!$omp target map(tofrom: myt) +myt%mys%a = myt%mys%a + 1 +!$omp end target + +if (myt%mys%a.ne.1) stop 1 + +end program myprog diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90 new file mode 100644 index 000000000000..254486b58805 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90 @@ -0,0 +1,115 @@ +! { dg-do run } + +program myprog +type t + integer, dimension (8) :: arr1 +end type t +type u + integer, dimension (9) :: arr1 +end type u +type v + integer, dimension (10) :: arr1 +end type v +type w + integer, dimension (11) :: arr1 +end type w +type y + integer, dimension(:), pointer :: ptr1 +end type y +type z + integer, dimension(:), pointer :: ptr1 +end type z + +!$omp declare mapper (t::x) map(tofrom:x%arr1) +!$omp declare mapper (u::x) map(tofrom:x%arr1(:)) +!$omp declare mapper (v::x) map(always,tofrom:x%arr1(1:3)) +!$omp declare mapper (w::x) map(tofrom:x%arr1(1)) +!$omp declare mapper (y::x) map(tofrom:x%ptr1) +!$omp declare mapper (z::x) map(to:x%ptr1) map(tofrom:x%ptr1(1:3)) + +type(t) :: myt +type(u) :: myu +type(v) :: myv +type(w) :: myw +type(y) :: myy +integer, target, dimension(8) :: arrtgt +type(z) :: myz +integer, target, dimension(8) :: arrtgt2 + +myy%ptr1 => arrtgt +myz%ptr1 => arrtgt2 + +myt%arr1 = 0 + +!$omp target map(myt) +myt%arr1(1) = myt%arr1(1) + 1 +!$omp end target + +!$omp target +myt%arr1(1) = myt%arr1(1) + 1 +!$omp end target + +if (myt%arr1(1).ne.2) stop 1 + +myu%arr1 = 0 + +!$omp target map(tofrom:myu%arr1(:)) +myu%arr1(1) = myu%arr1(1) + 1 +!$omp end target + +!$omp target +myu%arr1(1) = myu%arr1(1) + 1 +!$omp end target + +if (myu%arr1(1).ne.2) stop 2 + +myv%arr1 = 0 + +!$omp target map(always,tofrom:myv%arr1(1:3)) +myv%arr1(1) = myv%arr1(1) + 1 +!$omp end target + +!$omp target +myv%arr1(1) = myv%arr1(1) + 1 +!$omp end target + +if (myv%arr1(1).ne.2) stop 3 + +myw%arr1 = 0 + +!$omp target map(tofrom:myw%arr1(1)) +myw%arr1(1) = myw%arr1(1) + 1 +!$omp end target + +!$omp target +myw%arr1(1) = myw%arr1(1) + 1 +!$omp end target + +if (myw%arr1(1).ne.2) stop 4 + +myy%ptr1 = 0 + +!$omp target map(tofrom:myy%ptr1) +myy%ptr1(1) = myy%ptr1(1) + 1 +!$omp end target + +!$omp target map(to:myy%ptr1) map(tofrom:myy%ptr1(1:2)) +myy%ptr1(1) = myy%ptr1(1) + 1 +!$omp end target + +!$omp target +myy%ptr1(1) = myy%ptr1(1) + 1 +!$omp end target + +if (myy%ptr1(1).ne.3) stop 5 + +myz%ptr1(1) = 0 + +!$omp target +myz%ptr1(1) = myz%ptr1(1) + 1 +!$omp end target + +if (myz%ptr1(1).ne.1) stop 6 + +end program myprog + diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90 new file mode 100644 index 000000000000..deaf30b9575e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90 @@ -0,0 +1,27 @@ +! { dg-do run } + +type t + integer, dimension (8) :: arr1 +end type t +type u + type(t), dimension (:), pointer :: tarr +end type u + +type(u) :: myu +type(t), dimension (1), target :: myarray + +!$omp declare mapper (named: t :: x) map(x%arr1(1:4)) +!$omp declare mapper (u :: x) map(to: x%tarr) map(mapper(named), tofrom: x%tarr(1)) + +myu%tarr => myarray +myu%tarr(1)%arr1 = 0 + +! Unnamed mapper invoking named mapper + +!$omp target +myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1 +!$omp end target + +if (myu%tarr(1)%arr1(1).ne.1) stop 1 + +end