From patchwork Fri Apr 28 23:22:52 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 1775175 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=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from 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 (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4Q7TFC5Z9Jz23tZ for ; Sat, 29 Apr 2023 09:23:43 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 871093856970 for ; Fri, 28 Apr 2023 23:23:38 +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 1FF113858CDB for ; Fri, 28 Apr 2023 23:23:15 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1FF113858CDB Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.99,235,1677571200"; d="scan'208";a="3821646" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 28 Apr 2023 15:23:13 -0800 IronPort-SDR: RwTdKXnJpf9jCXZY3DjCg/0nRt5UJPa4sE+iGyZmOTb0ERl+1poHH/BoZFGfdSkK3EINH8NC0j tz49ctD/p+f9DGDdtNC4W/LxsjqoCuJYWtvcfQe/kqCdUrkznVmx/IejhjqfPm9F5IxVvMNlYf Xnp1pQwUqGlf9wmRebo28A5Od3oyIe3VzKdeGCo1HtMva2tLmBL2WDGZesOOAKaB7RG2ektyuI d+5sLw7JnJ2m4YFjZq1/hjwf5QX1fHv2bBuqdbJgoRQAJFqzNf27R3SW0wYkTOf4G1zRQ6xbVK mDg= From: Sandra Loosemore To: Subject: [PATCH 1/3] OpenMP: C support for imperfectly-nested loops Date: Fri, 28 Apr 2023 17:22:52 -0600 Message-ID: <20230428232254.628185-2-sandra@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20230428232254.628185-1-sandra@codesourcery.com> References: <20230428232254.628185-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-12.mgc.mentorg.com (147.34.90.212) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-9.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" OpenMP 5.0 removed the restriction that multiple collapsed loops must be perfectly nested, allowing "intervening code" (including nested BLOCKs) before or after each nested loop. In GCC this code is moved into the inner loop body by the respective front ends. This patch changes the C front end to use recursive descent parsing on nested loops within an "omp for" construct, rather than an iterative approach, in order to preserve proper nesting of compound statements. gcc/c/ChangeLog * c-parser.cc (struct c_parser): Add omp_for_parse_state field. (struct omp_for_parse_data): New. (c_parser_compound_statement_nostart): Special-case nested OMP loops and blocks in intervening code. (c_parser_while_statement): Reject in intervening code. (c_parser_do_statement): Likewise. (c_parser_for_statement): Likewise. (c_parser_postfix_expression_after_primary): Reject calls to OMP runtime routines in intervening code. (c_parser_pragma): Reject OMP pragmas in intervening code. (c_parser_omp_loop_nest): New, split from c_parser_omp_for_loop. (c_parser_omp_for_loop): Rewrite to use recursive descent and generalize handling for intervening code. gcc/ChangeLog * omp-api.h: New file. * omp-general.cc (omp_runtime_api_procname): New. (omp_runtime_api_call): Moved here from omp-low.cc, and make non-static. * omp-general.h: Include omp-api.h. * omp-low.cc (omp_runtime_api_call): Delete this copy. gcc/testsuite/ChangeLog * c-c++-common/goacc/collapse-1.c: Adjust expected error messages. * c-c++-common/goacc/tile-2.c: Likewise. * c-c++-common/gomp/imperfect1.c: New. * c-c++-common/gomp/imperfect2.c: New. * c-c++-common/gomp/imperfect3.c: New. * c-c++-common/gomp/imperfect4.c: New. * c-c++-common/gomp/imperfect5.c: New. * gcc.dg/gomp/collapse-1.c: Adjust expected error messages. libgomp/ChangeLog * testsuite/libgomp.c-c++-common/imperfect1.c: New. * testsuite/libgomp.c-c++-common/imperfect2.c: New. * testsuite/libgomp.c-c++-common/imperfect3.c: New. * testsuite/libgomp.c-c++-common/imperfect4.c: New. * testsuite/libgomp.c-c++-common/imperfect5.c: New. * testsuite/libgomp.c-c++-common/imperfect6.c: New. * testsuite/libgomp.c-c++-common/offload-imperfect1.c: New. * testsuite/libgomp.c-c++-common/offload-imperfect2.c: New. * testsuite/libgomp.c-c++-common/offload-imperfect3.c: New. * testsuite/libgomp.c-c++-common/offload-imperfect4.c: New. --- gcc/c/c-parser.cc | 692 +++++++++++------- gcc/omp-api.h | 32 + gcc/omp-general.cc | 134 ++++ gcc/omp-general.h | 1 + gcc/omp-low.cc | 129 ---- gcc/testsuite/c-c++-common/goacc/collapse-1.c | 14 +- gcc/testsuite/c-c++-common/goacc/tile-2.c | 4 +- gcc/testsuite/c-c++-common/gomp/imperfect1.c | 40 + gcc/testsuite/c-c++-common/gomp/imperfect2.c | 36 + gcc/testsuite/c-c++-common/gomp/imperfect3.c | 35 + gcc/testsuite/c-c++-common/gomp/imperfect4.c | 35 + gcc/testsuite/c-c++-common/gomp/imperfect5.c | 59 ++ gcc/testsuite/gcc.dg/gomp/collapse-1.c | 10 +- .../libgomp.c-c++-common/imperfect1.c | 76 ++ .../libgomp.c-c++-common/imperfect2.c | 114 +++ .../libgomp.c-c++-common/imperfect3.c | 119 +++ .../libgomp.c-c++-common/imperfect4.c | 117 +++ .../libgomp.c-c++-common/imperfect5.c | 49 ++ .../libgomp.c-c++-common/imperfect6.c | 115 +++ .../libgomp.c-c++-common/offload-imperfect1.c | 81 ++ .../libgomp.c-c++-common/offload-imperfect2.c | 122 +++ .../libgomp.c-c++-common/offload-imperfect3.c | 125 ++++ .../libgomp.c-c++-common/offload-imperfect4.c | 122 +++ 23 files changed, 1870 insertions(+), 391 deletions(-) create mode 100644 gcc/omp-api.h create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect1.c create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect2.c create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect3.c create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect4.c create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect5.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect1.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect2.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect3.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect4.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect5.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect6.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index c9f06930e3a..891e45ecaea 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -249,6 +249,10 @@ struct GTY(()) c_parser { /* Location of the last consumed token. */ location_t last_token_location; + + /* Holds state for parsing collapsed OMP_FOR loops. Managed by + c_parser_omp_for_loop. */ + struct omp_for_parse_data * GTY((skip)) omp_for_parse_state; }; /* Return a pointer to the Nth token in PARSERs tokens_buf. */ @@ -1525,6 +1529,23 @@ struct oacc_routine_data { /* Used for parsing objc foreach statements. */ static tree objc_foreach_break_label, objc_foreach_continue_label; +/* Used for parsing OMP for loops. See c_parser_omp_for_loop. */ +struct omp_for_parse_data { + tree declv, condv, incrv, initv; + tree pre_body; + tree bindings; + int collapse; + int depth; + location_t for_loc; + bool want_nested_loop : 1; + bool ordered : 1; + bool in_intervening_code : 1; + bool perfect_nesting_fail : 1; + bool fail : 1; + bool inscan : 1; + enum tree_code code; +}; + static bool c_parser_nth_token_starts_std_attributes (c_parser *, unsigned int); static tree c_parser_std_attribute_specifier_sequence (c_parser *); @@ -1616,6 +1637,7 @@ static void c_parser_omp_threadprivate (c_parser *); static void c_parser_omp_barrier (c_parser *); static void c_parser_omp_depobj (c_parser *); static void c_parser_omp_flush (c_parser *); +static tree c_parser_omp_loop_nest (c_parser *, bool *); static tree c_parser_omp_for_loop (location_t, c_parser *, enum tree_code, tree, tree *, bool *); static void c_parser_omp_taskwait (c_parser *); @@ -6123,6 +6145,15 @@ c_parser_compound_statement_nostart (c_parser *parser) bool last_label = false; bool save_valid_for_pragma = valid_location_for_stdc_pragma_p (); location_t label_loc = UNKNOWN_LOCATION; /* Quiet warning. */ + struct omp_for_parse_data *omp_for_parse_state; + + if (parser->omp_for_parse_state + && (parser->omp_for_parse_state->depth + < parser->omp_for_parse_state->collapse - 1)) + omp_for_parse_state = parser->omp_for_parse_state; + else + omp_for_parse_state = NULL; + if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE)) { location_t endloc = c_parser_peek_token (parser)->location; @@ -6289,6 +6320,15 @@ c_parser_compound_statement_nostart (c_parser *parser) continue; } } + else if (omp_for_parse_state + && c_parser_next_token_is_keyword (parser, RID_FOR) + && omp_for_parse_state->want_nested_loop) + { + /* Special treatment for collapsed loop nests. */ + omp_for_parse_state->depth++; + add_stmt (c_parser_omp_loop_nest (parser, NULL)); + omp_for_parse_state->depth--; + } else { statement: @@ -6296,7 +6336,52 @@ c_parser_compound_statement_nostart (c_parser *parser) last_label = false; last_stmt = true; mark_valid_location_for_stdc_pragma (false); - c_parser_statement_after_labels (parser, NULL); + if (omp_for_parse_state + && !c_parser_next_token_is (parser, CPP_OPEN_BRACE)) + { + /* Nested loops can only appear directly or nested in + compound statements. We have neither, so set the bit + to treat everything inside the subsequent statement + as intervening code instead. */ + bool want_nested_loop = omp_for_parse_state->want_nested_loop; + omp_for_parse_state->want_nested_loop = false; + + /* Only diagnose errors related to perfect nesting once. */ + if (!omp_for_parse_state->perfect_nesting_fail) + { + + /* OpenACC does not (yet) permit intervening code, in + addition to situations forbidden by the OpenMP spec. */ + if (omp_for_parse_state->code == OACC_LOOP) + { + error_at (omp_for_parse_state->for_loc, + "inner loops must be perfectly nested in " + "%<#pragma acc loop%>"); + omp_for_parse_state->perfect_nesting_fail = true; + } + else if (omp_for_parse_state->ordered) + { + error_at (omp_for_parse_state->for_loc, + "inner loops must be perfectly nested with " + "% clause"); + omp_for_parse_state->perfect_nesting_fail = true; + } + else if (omp_for_parse_state->inscan) + { + error_at (omp_for_parse_state->for_loc, + "inner loops must be perfectly nested with " + "% % clause"); + omp_for_parse_state->perfect_nesting_fail = true; + } + /* TODO: Also reject loops with TILE directive. */ + if (omp_for_parse_state->perfect_nesting_fail) + omp_for_parse_state->fail = true; + } + c_parser_statement_after_labels (parser, NULL); + omp_for_parse_state->want_nested_loop = want_nested_loop; + } + else + c_parser_statement_after_labels (parser, NULL); } parser->error = false; @@ -7138,6 +7223,16 @@ c_parser_while_statement (c_parser *parser, bool ivdep, unsigned short unroll, gcc_assert (c_parser_next_token_is_keyword (parser, RID_WHILE)); token_indent_info while_tinfo = get_token_indent_info (c_parser_peek_token (parser)); + + if (parser->omp_for_parse_state + && (parser->omp_for_parse_state->depth + < parser->omp_for_parse_state->collapse - 1)) + { + error_at (c_parser_peek_token (parser)->location, + "loop not permitted in intervening code in OMP loop body"); + parser->omp_for_parse_state->fail = true; + } + c_parser_consume_token (parser); block = c_begin_compound_stmt (flag_isoc99); loc = c_parser_peek_token (parser)->location; @@ -7189,6 +7284,16 @@ c_parser_do_statement (c_parser *parser, bool ivdep, unsigned short unroll) unsigned char save_in_statement; location_t loc; gcc_assert (c_parser_next_token_is_keyword (parser, RID_DO)); + + if (parser->omp_for_parse_state + && (parser->omp_for_parse_state->depth + < parser->omp_for_parse_state->collapse - 1)) + { + error_at (c_parser_peek_token (parser)->location, + "loop not permitted in intervening code in OMP loop body"); + parser->omp_for_parse_state->fail = true; + } + c_parser_consume_token (parser); if (c_parser_next_token_is (parser, CPP_SEMICOLON)) warning_at (c_parser_peek_token (parser)->location, @@ -7295,6 +7400,16 @@ c_parser_for_statement (c_parser *parser, bool ivdep, unsigned short unroll, gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR)); token_indent_info for_tinfo = get_token_indent_info (c_parser_peek_token (parser)); + + if (parser->omp_for_parse_state + && (parser->omp_for_parse_state->depth + < parser->omp_for_parse_state->collapse - 1)) + { + error_at (for_loc, + "loop not permitted in intervening code in OMP loop body"); + parser->omp_for_parse_state->fail = true; + } + c_parser_consume_token (parser); /* Open a compound statement in Objective-C as well, just in case this is as foreach expression. */ @@ -11234,6 +11349,14 @@ c_parser_postfix_expression_after_primary (c_parser *parser, && fndecl_built_in_p (expr.value, BUILT_IN_NORMAL) && vec_safe_length (exprlist) == 1) warn_for_abs (expr_loc, expr.value, (*exprlist)[0]); + if (parser->omp_for_parse_state + && parser->omp_for_parse_state->in_intervening_code + && omp_runtime_api_call (expr.value)) + { + error_at (expr_loc, "Calls to the OpenMP runtime API are " + "not permitted in intervening code"); + parser->omp_for_parse_state->fail = true; + } } start = expr.get_start (); @@ -13068,6 +13191,17 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p) input_location = c_parser_peek_token (parser)->location; id = c_parser_peek_token (parser)->pragma_kind; gcc_assert (id != PRAGMA_NONE); + if (parser->omp_for_parse_state + && parser->omp_for_parse_state->in_intervening_code + && id >= PRAGMA_OMP__START_ + && id <= PRAGMA_OMP__LAST_) + { + error_at (input_location, + "intervening code must not contain OpenMP directives"); + parser->omp_for_parse_state->fail = true; + c_parser_skip_until_found (parser, CPP_PRAGMA_EOL, NULL); + return false; + } switch (id) { @@ -20190,6 +20324,274 @@ c_parser_omp_scan_loop_body (c_parser *parser, bool open_brace_parsed) "expected %<}%>"); } + +/* This function parses a single level of a loop nest, invoking itself + recursively if necessary. + + loop-nest :: for (...) loop-body + loop-body :: loop-nest + | { [intervening-code] loop-body [intervening-code] } + | final-loop-body + intervening-code :: structured-block-sequence + final-loop-body :: structured-block + + For a collapsed loop nest, only a single OMP_FOR is built, pulling out + all the iterator information from the inner loops into the + parser->omp_for_parse_state structure. + + The iterator decl, init, cond, and incr are stored in vectors. + + Initialization code for iterator variables is collected into + parser->omp_for_parse_state->pre_body and ends up inserted directly + into the OMP_FOR structure. */ + +static tree +c_parser_omp_loop_nest (c_parser *parser, bool *if_p) +{ + tree decl, cond, incr, init; + tree body = NULL_TREE; + matching_parens parens; + bool moreloops; + unsigned char save_in_statement; + tree loop_scope; + location_t loc; + struct omp_for_parse_data *omp_for_parse_state + = parser->omp_for_parse_state; + + gcc_assert (omp_for_parse_state); + + /* We have already matched the FOR token but not consumed it yet. */ + loc = c_parser_peek_token (parser)->location; + gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR)); + c_parser_consume_token (parser); + + /* Forbid break/continue in the loop initializer, condition, and + increment expressions. */ + save_in_statement = in_statement; + in_statement = IN_OMP_BLOCK; + + /* We are not in intervening code now. */ + omp_for_parse_state->in_intervening_code = false; + + if (!parens.require_open (parser)) + { + omp_for_parse_state->fail = true; + return NULL_TREE; + } + + /* An implicit scope block surrounds each level of FOR loop, for + declarations of iteration variables at this loop depth. */ + loop_scope = c_begin_compound_stmt (true); + + /* Parse the initialization declaration or expression. */ + if (c_parser_next_tokens_start_declaration (parser)) + { + /* This is a declaration, which must be added to the pre_body code. */ + tree this_pre_body = push_stmt_list (); + c_in_omp_for = true; + c_parser_declaration_or_fndef (parser, true, true, true, true, true); + c_in_omp_for = false; + this_pre_body = pop_stmt_list (this_pre_body); + append_to_statement_list_force (this_pre_body, + &(omp_for_parse_state->pre_body)); + decl = check_for_loop_decls (omp_for_parse_state->for_loc, flag_isoc99); + if (decl == NULL) + goto error_init; + if (DECL_INITIAL (decl) == error_mark_node) + decl = error_mark_node; + init = decl; + } + else if (c_parser_next_token_is (parser, CPP_NAME) + && c_parser_peek_2nd_token (parser)->type == CPP_EQ) + { + struct c_expr decl_exp; + struct c_expr init_exp; + location_t init_loc; + + decl_exp = c_parser_postfix_expression (parser); + decl = decl_exp.value; + + c_parser_require (parser, CPP_EQ, "expected %<=%>"); + + init_loc = c_parser_peek_token (parser)->location; + init_exp = c_parser_expr_no_commas (parser, NULL); + init_exp = default_function_array_read_conversion (init_loc, + init_exp); + c_in_omp_for = true; + init = build_modify_expr (init_loc, decl, decl_exp.original_type, + NOP_EXPR, init_loc, init_exp.value, + init_exp.original_type); + c_in_omp_for = false; + init = c_process_expr_stmt (init_loc, init); + + c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>"); + } + else + { + error_init: + c_parser_error (parser, + "expected iteration declaration or initialization"); + c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, + "expected %<)%>"); + omp_for_parse_state->fail = true; + goto parse_next; + } + + /* Parse the loop condition. */ + cond = NULL_TREE; + if (c_parser_next_token_is_not (parser, CPP_SEMICOLON)) + { + location_t cond_loc = c_parser_peek_token (parser)->location; + c_in_omp_for = true; + struct c_expr cond_expr + = c_parser_binary_expression (parser, NULL, NULL_TREE); + c_in_omp_for = false; + + cond = cond_expr.value; + cond = c_objc_common_truthvalue_conversion (cond_loc, cond); + switch (cond_expr.original_code) + { + case GT_EXPR: + case GE_EXPR: + case LT_EXPR: + case LE_EXPR: + break; + case NE_EXPR: + if (omp_for_parse_state->code != OACC_LOOP) + break; + /* FALLTHRU. */ + default: + /* Can't be cond = error_mark_node, because we want to preserve + the location until c_finish_omp_for. */ + cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node); + break; + } + protected_set_expr_location (cond, cond_loc); + } + c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>"); + + /* Parse the increment expression. */ + incr = NULL_TREE; + if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN)) + { + location_t incr_loc = c_parser_peek_token (parser)->location; + + incr = c_process_expr_stmt (incr_loc, + c_parser_expression (parser).value); + } + parens.skip_until_found_close (parser); + + if (decl == NULL || decl == error_mark_node || init == error_mark_node) + omp_for_parse_state->fail = true; + else + { + TREE_VEC_ELT (omp_for_parse_state->declv, omp_for_parse_state->depth) + = decl; + TREE_VEC_ELT (omp_for_parse_state->initv, omp_for_parse_state->depth) + = init; + TREE_VEC_ELT (omp_for_parse_state->condv, omp_for_parse_state->depth) + = cond; + TREE_VEC_ELT (omp_for_parse_state->incrv, omp_for_parse_state->depth) + = incr; + } + +parse_next: + omp_for_parse_state->want_nested_loop = true; + moreloops = omp_for_parse_state->depth < omp_for_parse_state->collapse - 1; + if (moreloops && c_parser_next_token_is_keyword (parser, RID_FOR)) + { + omp_for_parse_state->depth++; + body = c_parser_omp_loop_nest (parser, if_p); + omp_for_parse_state->depth--; + } + else if (moreloops && c_parser_next_token_is (parser, CPP_OPEN_BRACE)) + { + /* This is the open brace in the loop-body grammar production. Rather + than trying to special-case braces, just parse it as a compound + statement and handle the nested loop-body case there. Note that + when we see a further open brace inside the compound statement + loop-body, we don't know whether it is the start of intervening + code that is a compound statement, or a level of braces + surrounding a nested loop-body. Use the WANT_NESTED_LOOP state + bit to ensure we have only one nested loop at each level. */ + omp_for_parse_state->in_intervening_code = true; + body = c_parser_compound_statement (parser, NULL); + omp_for_parse_state->in_intervening_code = false; + if (omp_for_parse_state->want_nested_loop) + { + /* We have already parsed the whole loop body and not found a + nested loop. */ + error_at (omp_for_parse_state->for_loc, + "not enough nested loops"); + omp_for_parse_state->fail = true; + } + if_p = NULL; + } + else + { + /* This is the final-loop-body case in the grammar: we have + something that is not a FOR and not an open brace. */ + if (moreloops) + { + /* If we were expecting a nested loop, give an error and mark + that parsing has failed, and try to recover by parsing the + body as regular code without further collapsing. */ + error_at (omp_for_parse_state->for_loc, + "not enough nested loops"); + omp_for_parse_state->fail = true; + } + in_statement = IN_OMP_FOR; + body = push_stmt_list (); + if (omp_for_parse_state->inscan) + c_parser_omp_scan_loop_body (parser, false); + else + add_stmt (c_parser_c99_block_statement (parser, if_p)); + body = pop_stmt_list (body); + } + in_statement = save_in_statement; + omp_for_parse_state->want_nested_loop = false; + omp_for_parse_state->in_intervening_code = true; + + /* Pop and return the implicit scope surrounding this level of loop. + Any iteration variable bound in loop_scope is pulled out and later + will be added to the scope surrounding the entire OMP_FOR. That + keeps the gimplifier happy later on, and meanwhile we have already + resolved all references to the iteration variable in its true scope. */ + add_stmt (body); + body = c_end_compound_stmt (loc, loop_scope, true); + if (decl && TREE_CODE (body) == BIND_EXPR) + { + tree t = BIND_EXPR_VARS (body); + tree prev = NULL_TREE, next = NULL_TREE; + while (t) + { + next = DECL_CHAIN (t); + if (t == decl) + { + if (prev) + DECL_CHAIN (prev) = next; + else + { + BIND_EXPR_VARS (body) = next; + BLOCK_VARS (BIND_EXPR_BLOCK (body)) = next; + } + DECL_CHAIN (t) = omp_for_parse_state->bindings; + omp_for_parse_state->bindings = t; + break; + } + else + { + prev = t; + t = next; + } + } + if (BIND_EXPR_VARS (body) == NULL_TREE) + body = BIND_EXPR_BODY (body); + } + + return body; +} + /* Parse the restricted form of loop statements allowed by OpenACC and OpenMP. The real trick here is to determine the loop control variable early so that we can push a new decl if necessary to make it private. @@ -20200,17 +20602,15 @@ static tree c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code, tree clauses, tree *cclauses, bool *if_p) { - tree decl, cond, incr, body, init, stmt, cl; - unsigned char save_in_statement; - tree declv, condv, incrv, initv, ret = NULL_TREE; - tree pre_body = NULL_TREE, this_pre_body; + tree body, stmt, cl; + tree ret = NULL_TREE; tree ordered_cl = NULL_TREE; - bool fail = false, open_brace_parsed = false; - int i, collapse = 1, ordered = 0, count, nbraces = 0; + int i, collapse = 1, ordered = 0, count; location_t for_loc; bool tiling = false; bool inscan = false; - vec *for_block = make_tree_vector (); + struct omp_for_parse_data data; + struct omp_for_parse_data *save_data = parser->omp_for_parse_state; for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl)) if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE) @@ -20243,250 +20643,53 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code, gcc_assert (tiling || (collapse >= 1 && ordered >= 0)); count = ordered ? ordered : collapse; - declv = make_tree_vec (count); - initv = make_tree_vec (count); - condv = make_tree_vec (count); - incrv = make_tree_vec (count); - if (!c_parser_next_token_is_keyword (parser, RID_FOR)) { c_parser_error (parser, "for statement expected"); return NULL; } for_loc = c_parser_peek_token (parser)->location; - c_parser_consume_token (parser); - - /* Forbid break/continue in the loop initializer, condition, and - increment expressions. */ - save_in_statement = in_statement; - in_statement = IN_OMP_BLOCK; - - for (i = 0; i < count; i++) - { - int bracecount = 0; - - matching_parens parens; - if (!parens.require_open (parser)) - goto pop_scopes; - - /* Parse the initialization declaration or expression. */ - if (c_parser_next_tokens_start_declaration (parser)) - { - if (i > 0) - vec_safe_push (for_block, c_begin_compound_stmt (true)); - this_pre_body = push_stmt_list (); - c_in_omp_for = true; - c_parser_declaration_or_fndef (parser, true, true, true, true, true); - c_in_omp_for = false; - if (this_pre_body) - { - this_pre_body = pop_stmt_list (this_pre_body); - if (pre_body) - { - tree t = pre_body; - pre_body = push_stmt_list (); - add_stmt (t); - add_stmt (this_pre_body); - pre_body = pop_stmt_list (pre_body); - } - else - pre_body = this_pre_body; - } - decl = check_for_loop_decls (for_loc, flag_isoc99); - if (decl == NULL) - goto error_init; - if (DECL_INITIAL (decl) == error_mark_node) - decl = error_mark_node; - init = decl; - } - else if (c_parser_next_token_is (parser, CPP_NAME) - && c_parser_peek_2nd_token (parser)->type == CPP_EQ) - { - struct c_expr decl_exp; - struct c_expr init_exp; - location_t init_loc; - - decl_exp = c_parser_postfix_expression (parser); - decl = decl_exp.value; - - c_parser_require (parser, CPP_EQ, "expected %<=%>"); - - init_loc = c_parser_peek_token (parser)->location; - init_exp = c_parser_expr_no_commas (parser, NULL); - init_exp = default_function_array_read_conversion (init_loc, - init_exp); - c_in_omp_for = true; - init = build_modify_expr (init_loc, decl, decl_exp.original_type, - NOP_EXPR, init_loc, init_exp.value, - init_exp.original_type); - c_in_omp_for = false; - init = c_process_expr_stmt (init_loc, init); - - c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>"); - } - else - { - error_init: - c_parser_error (parser, - "expected iteration declaration or initialization"); - c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, - "expected %<)%>"); - fail = true; - goto parse_next; - } - - /* Parse the loop condition. */ - cond = NULL_TREE; - if (c_parser_next_token_is_not (parser, CPP_SEMICOLON)) - { - location_t cond_loc = c_parser_peek_token (parser)->location; - c_in_omp_for = true; - struct c_expr cond_expr - = c_parser_binary_expression (parser, NULL, NULL_TREE); - c_in_omp_for = false; - - cond = cond_expr.value; - cond = c_objc_common_truthvalue_conversion (cond_loc, cond); - switch (cond_expr.original_code) - { - case GT_EXPR: - case GE_EXPR: - case LT_EXPR: - case LE_EXPR: - break; - case NE_EXPR: - if (code != OACC_LOOP) - break; - /* FALLTHRU. */ - default: - /* Can't be cond = error_mark_node, because we want to preserve - the location until c_finish_omp_for. */ - cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node); - break; - } - protected_set_expr_location (cond, cond_loc); - } - c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>"); - - /* Parse the increment expression. */ - incr = NULL_TREE; - if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN)) - { - location_t incr_loc = c_parser_peek_token (parser)->location; - incr = c_process_expr_stmt (incr_loc, - c_parser_expression (parser).value); - } - parens.skip_until_found_close (parser); - - if (decl == NULL || decl == error_mark_node || init == error_mark_node) - fail = true; - else - { - TREE_VEC_ELT (declv, i) = decl; - TREE_VEC_ELT (initv, i) = init; - TREE_VEC_ELT (condv, i) = cond; - TREE_VEC_ELT (incrv, i) = incr; - } - - parse_next: - if (i == count - 1) - break; - - /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed - in between the collapsed for loops to be still considered perfectly - nested. Hopefully the final version clarifies this. - For now handle (multiple) {'s and empty statements. */ - do - { - if (c_parser_next_token_is_keyword (parser, RID_FOR)) - { - c_parser_consume_token (parser); - break; - } - else if (c_parser_next_token_is (parser, CPP_OPEN_BRACE)) - { - c_parser_consume_token (parser); - bracecount++; - } - else if (bracecount - && c_parser_next_token_is (parser, CPP_SEMICOLON)) - c_parser_consume_token (parser); - else - { - c_parser_error (parser, "not enough perfectly nested loops"); - if (bracecount) - { - open_brace_parsed = true; - bracecount--; - } - fail = true; - count = 0; - break; - } - } - while (1); - - nbraces += bracecount; - } - - if (nbraces) - if_p = NULL; - - in_statement = IN_OMP_FOR; - body = push_stmt_list (); - - if (inscan) - c_parser_omp_scan_loop_body (parser, open_brace_parsed); - else if (open_brace_parsed) - { - location_t here = c_parser_peek_token (parser)->location; - stmt = c_begin_compound_stmt (true); - c_parser_compound_statement_nostart (parser); - add_stmt (c_end_compound_stmt (here, stmt, true)); - } - else - add_stmt (c_parser_c99_block_statement (parser, if_p)); - - body = pop_stmt_list (body); - in_statement = save_in_statement; - - while (nbraces) - { - if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE)) - { - c_parser_consume_token (parser); - nbraces--; - } - else if (c_parser_next_token_is (parser, CPP_SEMICOLON)) - c_parser_consume_token (parser); - else - { - c_parser_error (parser, "collapsed loops not perfectly nested"); - while (nbraces) - { - location_t here = c_parser_peek_token (parser)->location; - stmt = c_begin_compound_stmt (true); - add_stmt (body); - c_parser_compound_statement_nostart (parser); - body = c_end_compound_stmt (here, stmt, true); - nbraces--; - } - goto pop_scopes; - } + /* Initialize parse state for recursive descent. */ + data.declv = make_tree_vec (count); + data.initv = make_tree_vec (count); + data.condv = make_tree_vec (count); + data.incrv = make_tree_vec (count); + data.pre_body = NULL_TREE;; + data.bindings = NULL_TREE; + data.for_loc = for_loc; + data.collapse = count; + data.depth = 0; + data.want_nested_loop = true; + data.ordered = ordered > 0; + data.in_intervening_code = false; + data.perfect_nesting_fail = false; + data.fail = false; + data.inscan = inscan; + data.code = code; + parser->omp_for_parse_state = &data; + + body = c_parser_omp_loop_nest (parser, if_p); + for (tree t = data.bindings; t; ) + { + tree n = TREE_CHAIN (t); + TREE_CHAIN (t) = NULL_TREE; + pushdecl (t); + t = n; } /* Only bother calling c_finish_omp_for if we haven't already generated an error from the initialization parsing. */ - if (!fail) + if (!data.fail) { c_in_omp_for = true; - stmt = c_finish_omp_for (loc, code, declv, NULL, initv, condv, - incrv, body, pre_body, true); + stmt = c_finish_omp_for (loc, code, data.declv, NULL, data.initv, + data.condv, data.incrv, + body, data.pre_body, true); c_in_omp_for = false; /* Check for iterators appearing in lb, b or incr expressions. */ - if (stmt && !c_omp_check_loop_iv (stmt, declv, NULL)) + if (stmt && !c_omp_check_loop_iv (stmt, data.declv, NULL)) stmt = NULL_TREE; if (stmt) @@ -20538,7 +20741,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code, else { for (i = 0; i < count; i++) - if (TREE_VEC_ELT (declv, i) == OMP_CLAUSE_DECL (*c)) + if (TREE_VEC_ELT (data.declv, i) == OMP_CLAUSE_DECL (*c)) break; if (i == count) c = &OMP_CLAUSE_CHAIN (*c); @@ -20551,7 +20754,8 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code, } else { - /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES. */ + /* Move lastprivate (decl) clause to + OMP_FOR_CLAUSES. */ tree l = *c; *c = OMP_CLAUSE_CHAIN (*c); if (code == OMP_SIMD) @@ -20572,16 +20776,8 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code, } ret = stmt; } -pop_scopes: - while (!for_block->is_empty ()) - { - /* FIXME diagnostics: LOC below should be the actual location of - this particular for block. We need to build a list of - locations to go along with FOR_BLOCK. */ - stmt = c_end_compound_stmt (loc, for_block->pop (), true); - add_stmt (stmt); - } - release_tree_vector (for_block); + + parser->omp_for_parse_state = save_data; return ret; } diff --git a/gcc/omp-api.h b/gcc/omp-api.h new file mode 100644 index 00000000000..2a7ec7b72a6 --- /dev/null +++ b/gcc/omp-api.h @@ -0,0 +1,32 @@ +/* Functions for querying whether a function name is reserved by the + OpenMP API. This is used for error checking. + + Copyright (C) 2023 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +#ifndef GCC_OMP_API_H +#define GCC_OMP_API_H + +#include "coretypes.h" + +/* In omp-general.cc, but declared in a separate header file for + convenience of the Fortran front end. */ +extern bool omp_runtime_api_procname (const char *name); +extern bool omp_runtime_api_call (const_tree fndecl); + +#endif diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc index eefdcb54590..1e31014c454 100644 --- a/gcc/omp-general.cc +++ b/gcc/omp-general.cc @@ -3013,4 +3013,138 @@ omp_build_component_ref (tree obj, tree field) return ret; } +/* Return true if NAME is the name of an omp_* runtime API call. */ +bool +omp_runtime_api_procname (const char *name) +{ + if (!startswith (name, "omp_")) + return false; + + static const char *omp_runtime_apis[] = + { + /* This array has 3 sections. First omp_* calls that don't + have any suffixes. */ + "aligned_alloc", + "aligned_calloc", + "alloc", + "calloc", + "free", + "get_mapped_ptr", + "realloc", + "target_alloc", + "target_associate_ptr", + "target_disassociate_ptr", + "target_free", + "target_is_accessible", + "target_is_present", + "target_memcpy", + "target_memcpy_async", + "target_memcpy_rect", + "target_memcpy_rect_async", + NULL, + /* Now omp_* calls that are available as omp_* and omp_*_; however, the + DECL_NAME is always omp_* without tailing underscore. */ + "capture_affinity", + "destroy_allocator", + "destroy_lock", + "destroy_nest_lock", + "display_affinity", + "fulfill_event", + "get_active_level", + "get_affinity_format", + "get_cancellation", + "get_default_allocator", + "get_default_device", + "get_device_num", + "get_dynamic", + "get_initial_device", + "get_level", + "get_max_active_levels", + "get_max_task_priority", + "get_max_teams", + "get_max_threads", + "get_nested", + "get_num_devices", + "get_num_places", + "get_num_procs", + "get_num_teams", + "get_num_threads", + "get_partition_num_places", + "get_place_num", + "get_proc_bind", + "get_supported_active_levels", + "get_team_num", + "get_teams_thread_limit", + "get_thread_limit", + "get_thread_num", + "get_wtick", + "get_wtime", + "in_explicit_task", + "in_final", + "in_parallel", + "init_lock", + "init_nest_lock", + "is_initial_device", + "pause_resource", + "pause_resource_all", + "set_affinity_format", + "set_default_allocator", + "set_lock", + "set_nest_lock", + "test_lock", + "test_nest_lock", + "unset_lock", + "unset_nest_lock", + NULL, + /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however, + as DECL_NAME only omp_* and omp_*_8 appear. */ + "display_env", + "get_ancestor_thread_num", + "init_allocator", + "get_partition_place_nums", + "get_place_num_procs", + "get_place_proc_ids", + "get_schedule", + "get_team_size", + "set_default_device", + "set_dynamic", + "set_max_active_levels", + "set_nested", + "set_num_teams", + "set_num_threads", + "set_schedule", + "set_teams_thread_limit" + }; + + int mode = 0; + for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++) + { + if (omp_runtime_apis[i] == NULL) + { + mode++; + continue; + } + size_t len = strlen (omp_runtime_apis[i]); + if (strncmp (name + 4, omp_runtime_apis[i], len) == 0 + && (name[4 + len] == '\0' + || (mode > 1 && strcmp (name + 4 + len, "_8") == 0))) + return true; + } + return false; +} + +/* Return true if FNDECL is an omp_* runtime API call. */ + +bool +omp_runtime_api_call (const_tree fndecl) +{ + tree declname = DECL_NAME (fndecl); + if (!declname + || (DECL_CONTEXT (fndecl) != NULL_TREE + && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL) + || !TREE_PUBLIC (fndecl)) + return false; + return omp_runtime_api_procname (IDENTIFIER_POINTER (declname)); +} + #include "gt-omp-general.h" diff --git a/gcc/omp-general.h b/gcc/omp-general.h index 92717db1628..1a52bfdb56b 100644 --- a/gcc/omp-general.h +++ b/gcc/omp-general.h @@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see #define GCC_OMP_GENERAL_H #include "gomp-constants.h" +#include "omp-api.h" /* Flags for an OpenACC loop. */ diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index dddf5b59d8f..77adf97896a 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -4006,135 +4006,6 @@ setjmp_or_longjmp_p (const_tree fndecl) return !strcmp (name, "setjmp") || !strcmp (name, "longjmp"); } -/* Return true if FNDECL is an omp_* runtime API call. */ - -static bool -omp_runtime_api_call (const_tree fndecl) -{ - tree declname = DECL_NAME (fndecl); - if (!declname - || (DECL_CONTEXT (fndecl) != NULL_TREE - && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL) - || !TREE_PUBLIC (fndecl)) - return false; - - const char *name = IDENTIFIER_POINTER (declname); - if (!startswith (name, "omp_")) - return false; - - static const char *omp_runtime_apis[] = - { - /* This array has 3 sections. First omp_* calls that don't - have any suffixes. */ - "aligned_alloc", - "aligned_calloc", - "alloc", - "calloc", - "free", - "get_mapped_ptr", - "realloc", - "target_alloc", - "target_associate_ptr", - "target_disassociate_ptr", - "target_free", - "target_is_accessible", - "target_is_present", - "target_memcpy", - "target_memcpy_async", - "target_memcpy_rect", - "target_memcpy_rect_async", - NULL, - /* Now omp_* calls that are available as omp_* and omp_*_; however, the - DECL_NAME is always omp_* without tailing underscore. */ - "capture_affinity", - "destroy_allocator", - "destroy_lock", - "destroy_nest_lock", - "display_affinity", - "fulfill_event", - "get_active_level", - "get_affinity_format", - "get_cancellation", - "get_default_allocator", - "get_default_device", - "get_device_num", - "get_dynamic", - "get_initial_device", - "get_level", - "get_max_active_levels", - "get_max_task_priority", - "get_max_teams", - "get_max_threads", - "get_nested", - "get_num_devices", - "get_num_places", - "get_num_procs", - "get_num_teams", - "get_num_threads", - "get_partition_num_places", - "get_place_num", - "get_proc_bind", - "get_supported_active_levels", - "get_team_num", - "get_teams_thread_limit", - "get_thread_limit", - "get_thread_num", - "get_wtick", - "get_wtime", - "in_explicit_task", - "in_final", - "in_parallel", - "init_lock", - "init_nest_lock", - "is_initial_device", - "pause_resource", - "pause_resource_all", - "set_affinity_format", - "set_default_allocator", - "set_lock", - "set_nest_lock", - "test_lock", - "test_nest_lock", - "unset_lock", - "unset_nest_lock", - NULL, - /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however, - as DECL_NAME only omp_* and omp_*_8 appear. */ - "display_env", - "get_ancestor_thread_num", - "init_allocator", - "get_partition_place_nums", - "get_place_num_procs", - "get_place_proc_ids", - "get_schedule", - "get_team_size", - "set_default_device", - "set_dynamic", - "set_max_active_levels", - "set_nested", - "set_num_teams", - "set_num_threads", - "set_schedule", - "set_teams_thread_limit" - }; - - int mode = 0; - for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++) - { - if (omp_runtime_apis[i] == NULL) - { - mode++; - continue; - } - size_t len = strlen (omp_runtime_apis[i]); - if (strncmp (name + 4, omp_runtime_apis[i], len) == 0 - && (name[4 + len] == '\0' - || (mode > 1 && strcmp (name + 4 + len, "_8") == 0))) - return true; - } - return false; -} - /* Helper function for scan_omp. Callback for walk_gimple_stmt used to scan for OMP directives in diff --git a/gcc/testsuite/c-c++-common/goacc/collapse-1.c b/gcc/testsuite/c-c++-common/goacc/collapse-1.c index 11b14383983..05025e64af7 100644 --- a/gcc/testsuite/c-c++-common/goacc/collapse-1.c +++ b/gcc/testsuite/c-c++-common/goacc/collapse-1.c @@ -8,8 +8,8 @@ f1 (void) { #pragma acc parallel #pragma acc loop collapse (2) - for (i = 0; i < 5; i++) - ; /* { dg-error "not enough perfectly nested" } */ + for (i = 0; i < 5; i++) /* { dg-error "not enough nested loops" } */ + ; { for (j = 0; j < 5; j++) ; @@ -40,7 +40,7 @@ f3 (void) #pragma acc loop collapse (2) for (i = 0; i < 5; i++) { - int k = foo (); /* { dg-error "not enough perfectly nested" } */ + int k = foo (); { { for (j = 0; j < 5; j++) @@ -56,12 +56,12 @@ f4 (void) { #pragma acc parallel #pragma acc loop collapse (2) - for (i = 0; i < 5; i++) + for (i = 0; i < 5; i++) /* { dg-error "inner loops must be perfectly nested" } */ { { for (j = 0; j < 5; j++) ; - foo (); /* { dg-error "collapsed loops not perfectly nested before" } */ + foo (); } } } @@ -71,13 +71,13 @@ f5 (void) { #pragma acc parallel #pragma acc loop collapse (2) - for (i = 0; i < 5; i++) + for (i = 0; i < 5; i++) /* { dg-error "inner loops must be perfectly nested" } */ { { for (j = 0; j < 5; j++) ; } - foo (); /* { dg-error "collapsed loops not perfectly nested before" } */ + foo (); } } diff --git a/gcc/testsuite/c-c++-common/goacc/tile-2.c b/gcc/testsuite/c-c++-common/goacc/tile-2.c index c8b240d225b..dc306703260 100644 --- a/gcc/testsuite/c-c++-common/goacc/tile-2.c +++ b/gcc/testsuite/c-c++-common/goacc/tile-2.c @@ -3,8 +3,8 @@ int main () #pragma acc parallel { #pragma acc loop tile (*,*) - for (int ix = 0; ix < 30; ix++) - ; /* { dg-error "not enough" } */ + for (int ix = 0; ix < 30; ix++) /* { dg-error "not enough" } */ + ; #pragma acc loop tile (*,*) for (int ix = 0; ix < 30; ix++) diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect1.c b/gcc/testsuite/c-c++-common/gomp/imperfect1.c new file mode 100644 index 00000000000..a95f972e0d7 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/imperfect1.c @@ -0,0 +1,40 @@ +/* { dg-do compile } */ + +/* This test case is expected to fail due to errors. */ + +static int f1count[3], f2count[3]; + +int f1 (int depth, int iter); +int f2 (int depth, int iter); + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + f1 (0, i); + for (j = 0; j < a2; j++) + { +#pragma omp barrier /* { dg-error "intervening code must not contain OpenMP directives" } */ + f1 (1, j); + if (i == 2) + continue; /* { dg-error "invalid exit" } */ + else + break; /* { dg-error "invalid exit" } */ + for (k = 0; k < a3; k++) + { + f1 (2, k); + f2 (2, k); + } + f2 (1, j); + } + for (k = 0; k < a3; k++) /* { dg-error "loop not permitted in intervening code " } */ + { + f1 (2, k); + f2 (2, k); + } + f2 (0, i); + } +} diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect2.c b/gcc/testsuite/c-c++-common/gomp/imperfect2.c new file mode 100644 index 00000000000..9649f28503b --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/imperfect2.c @@ -0,0 +1,36 @@ +/* { dg-do compile } */ + +/* This test case is expected to fail due to errors. */ + +/* These functions that are part of the OpenMP runtime API would ordinarily + be declared in omp.h, but we don't have that here. */ +extern int omp_get_num_threads(void); +extern int omp_get_max_threads(void); + +static int f1count[3], f2count[3]; + +int f1 (int depth, int iter); +int f2 (int depth, int iter); + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + f1 (0, i); + for (j = 0; j < omp_get_num_threads (); j++) /* This is OK */ + { + f1 (1, omp_get_num_threads ()); /* { dg-error "not permitted in intervening code" } */ + for (k = omp_get_num_threads (); k < a3; k++) /* This is OK */ + { + f1 (2, omp_get_num_threads ()); + f2 (2, omp_get_max_threads ()); + } + f2 (1, omp_get_max_threads ()); /* { dg-error "not permitted in intervening code" } */ + } + f2 (0, i); + } +} + + diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect3.c b/gcc/testsuite/c-c++-common/gomp/imperfect3.c new file mode 100644 index 00000000000..a29157094b0 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/imperfect3.c @@ -0,0 +1,35 @@ +/* { dg-do compile } */ + +/* This test case is expected to fail due to errors. */ + +/* Test that the imperfectly-nested loops with the ordered clause gives + an error, and that there is only one error (and not one on every + intervening statement). */ + +static int f1count[3], f2count[3]; + +int f1 (int depth, int iter); +int f2 (int depth, int iter); + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for ordered(3) + for (i = 0; i < a1; i++) /* { dg-error "inner loops must be perfectly nested" } */ + { + f1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + for (k = 0; k < a3; k++) + { + f1 (2, k); + f2 (2, k); + } + f2 (1, j); + } + f2 (0, i); + } +} + diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect4.c b/gcc/testsuite/c-c++-common/gomp/imperfect4.c new file mode 100644 index 00000000000..e5feff730a9 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/imperfect4.c @@ -0,0 +1,35 @@ +/* { dg-do compile } */ + +/* This test case is expected to fail due to errors. */ + +static int f1count[3], f2count[3]; + +int f1 (int depth, int iter); +int f2 (int depth, int iter); + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(4) + for (i = 0; i < a1; i++) /* { dg-error "not enough nested loops" } */ + { + f1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + for (k = 0; k < a3; k++) + { + /* According to the grammar, this is intervening code; we + don't know that we are also missing a nested for loop + until we have parsed this whole compound expression. */ +#pragma omp barrier /* { dg-error "intervening code must not contain OpenMP directives" } */ + f1 (2, k); + f2 (2, k); + } + f2 (1, j); + } + f2 (0, i); + } +} + diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect5.c b/gcc/testsuite/c-c++-common/gomp/imperfect5.c new file mode 100644 index 00000000000..7294a816aba --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/imperfect5.c @@ -0,0 +1,59 @@ +/* { dg-do compile } */ + +/* This test case is expected to fail due to errors. */ + +static int f1count[3], f2count[3]; + +int f1 (int depth, int iter); +int f2 (int depth, int iter); +int ijk (int x, int y, int z); +void f3 (int sum); + +/* This function isn't particularly meaningful, but it should compile without + error. */ +int s1 (int a1, int a2, int a3) +{ + int i, j, k; + int r = 0; + +#pragma omp simd collapse(3) reduction (inscan, +:r) + for (i = 0; i < a1; i++) + { + for (j = 0; j < a2; j++) + { + for (k = 0; k < a3; k++) + { + r = r + ijk (i, j, k); +#pragma omp scan exclusive (r) + f3 (r); + } + } + } + return r; +} + +/* Adding intervening code should trigger an error. */ +int s2 (int a1, int a2, int a3) +{ + int i, j, k; + int r = 0; + +#pragma omp simd collapse(3) reduction (inscan, +:r) + for (i = 0; i < a1; i++) /* { dg-error "inner loops must be perfectly nested" } */ + { + f1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + for (k = 0; k < a3; k++) + { + r = r + ijk (i, j, k); +#pragma omp scan exclusive (r) + f3 (r); + } + f2 (1, j); + } + f2 (0, i); + } + return r; +} diff --git a/gcc/testsuite/gcc.dg/gomp/collapse-1.c b/gcc/testsuite/gcc.dg/gomp/collapse-1.c index 89b76bb669c..16a102ff3fd 100644 --- a/gcc/testsuite/gcc.dg/gomp/collapse-1.c +++ b/gcc/testsuite/gcc.dg/gomp/collapse-1.c @@ -8,8 +8,8 @@ void f1 (void) { #pragma omp for collapse (2) - for (i = 0; i < 5; i++) - ; /* { dg-error "not enough perfectly nested" } */ + for (i = 0; i < 5; i++) /* { dg-error "not enough nested loops" } */ + ; { for (j = 0; j < 5; j++) ; @@ -38,7 +38,7 @@ f3 (void) #pragma omp for collapse (2) for (i = 0; i < 5; i++) { - int k = foo (); /* { dg-error "not enough perfectly nested" } */ + int k = foo (); { { for (j = 0; j < 5; j++) @@ -58,7 +58,7 @@ f4 (void) { for (j = 0; j < 5; j++) ; - foo (); /* { dg-error "collapsed loops not perfectly nested before" } */ + foo (); } } } @@ -73,7 +73,7 @@ f5 (void) for (j = 0; j < 5; j++) ; } - foo (); /* { dg-error "collapsed loops not perfectly nested before" } */ + foo (); } } diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c new file mode 100644 index 00000000000..cafdcaf25b0 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c @@ -0,0 +1,76 @@ +/* { dg-do run } */ + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + f2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + f1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + for (k = 0; k < a3; k++) + { + f1 (2, k); + f2 (2, k); + } + f2 (1, j); + } + f2 (0, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c new file mode 100644 index 00000000000..e2098006eab --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c @@ -0,0 +1,114 @@ +/* { dg-do run } */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + f1 (0, i); + { + g1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + { + g1 (1, j); + for (k = 0; k < a3; k++) + { + f1 (2, k); + { + g1 (2, k); + g2 (2, k); + } + f2 (2, k); + } + g2 (1, j); + } + f2 (1, j); + } + g2 (0, i); + } + f2 (0, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c new file mode 100644 index 00000000000..feb5e32d1d6 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c @@ -0,0 +1,119 @@ +/* { dg-do run } */ + +/* Like imperfect2.c, but includes bindings in the blocks. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + int local0 = 0; + f1 (local0, i); + { + g1 (local0, i); + for (j = 0; j < a2; j++) + { + int local1 = 1; + f1 (local1, j); + { + g1 (local1, j); + for (k = 0; k < a3; k++) + { + int local2 = 2; + f1 (local2, k); + { + g1 (local2, k); + g2 (local2, k); + } + f2 (local2, k); + } + g2 (local1, j); + } + f2 (local1, j); + } + g2 (local0, i); + } + f2 (local0, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c new file mode 100644 index 00000000000..e29301bfbad --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c @@ -0,0 +1,117 @@ +/* { dg-do run } */ + +/* Like imperfect2.c, but includes blocks that are themselves intervening + code. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + { f1 (0, i); } + { + g1 (0, i); + for (j = 0; j < a2; j++) + { + { f1 (1, j); } + { + { g1 (1, j); } + for (k = 0; k < a3; k++) + { + f1 (2, k); + { + g1 (2, k); + g2 (2, k); + } + f2 (2, k); + } + { g2 (1, j); } + } + { f2 (1, j); } + } + { g2 (0, i); } + } + { f2 (0, i); } + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c new file mode 100644 index 00000000000..7bd4f12d472 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c @@ -0,0 +1,49 @@ +/* { dg-do run } */ + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +static int inner_loop_count = 0; +static int intervening_code_count = 0; + +void +g (int x, int y) +{ + inner_loop_count++; +} + +int +foo (int imax, int jmax) +{ + int j = 0; + +#pragma omp for collapse(2) + for (int i = 0; i < imax; ++i) + { + /* All the intervening code at the same level must be executed + the same number of times. */ + ++intervening_code_count; + for (int j = 0; j < jmax; ++j) + { + g (i, j); + } + /* This is the outer j, not the one from the inner collapsed loop. */ + ++j; + } + return j; +} + +int +main (void) +{ + int j = foo (5, 3); + if (j != intervening_code_count) + abort (); + if (inner_loop_count != 5 * 3) + abort (); + if (intervening_code_count < 5 || intervening_code_count > 5 * 3) + abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c new file mode 100644 index 00000000000..808c6540890 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c @@ -0,0 +1,115 @@ +/* { dg-do run } */ + +/* Like imperfect4.c, but bind the iteration variables in the loops. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + +#pragma omp for collapse(3) + for (int i = 0; i < a1; i++) + { + { f1 (0, i); } + { + g1 (0, i); + for (int j = 0; j < a2; j++) + { + { f1 (1, j); } + { + { g1 (1, j); } + for (int k = 0; k < a3; k++) + { + f1 (2, k); + { + g1 (2, k); + g2 (2, k); + } + f2 (2, k); + } + { g2 (1, j); } + } + { f2 (1, j); } + } + { g2 (0, i); } + } + { f2 (0, i); } + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c new file mode 100644 index 00000000000..53bc611ace3 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c @@ -0,0 +1,81 @@ +/* { dg-do run } */ + +/* Like imperfect1.c, but enables offloading. */ + +static int f1count[3], f2count[3]; +#pragma omp declare target enter (f1count, f2count) + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + #pragma omp atomic + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + #pragma omp atomic + f2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count) + for (i = 0; i < a1; i++) + { + f1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + for (k = 0; k < a3; k++) + { + f1 (2, k); + f2 (2, k); + } + f2 (1, j); + } + f2 (0, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c new file mode 100644 index 00000000000..bc2901a517e --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c @@ -0,0 +1,122 @@ +/* { dg-do run } */ + +/* Like imperfect2.c, but enables offloading. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; +#pragma omp declare target enter (f1count, f2count) +#pragma omp declare target enter (g1count, g2count) + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + #pragma omp atomic + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + #pragma omp atomic + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + #pragma omp atomic + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + #pragma omp atomic + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count) + for (i = 0; i < a1; i++) + { + f1 (0, i); + { + g1 (0, i); + for (j = 0; j < a2; j++) + { + f1 (1, j); + { + g1 (1, j); + for (k = 0; k < a3; k++) + { + f1 (2, k); + { + g1 (2, k); + g2 (2, k); + } + f2 (2, k); + } + g2 (1, j); + } + f2 (1, j); + } + g2 (0, i); + } + f2 (0, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c new file mode 100644 index 00000000000..ddcfcf4b7eb --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c @@ -0,0 +1,125 @@ +/* { dg-do run } */ + +/* Like imperfect3.c, but enables offloading. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; +#pragma omp declare target enter (f1count, f2count) +#pragma omp declare target enter (g1count, g2count) + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + #pragma omp atomic + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + #pragma omp atomic + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + #pragma omp atomic + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + #pragma omp atomic + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count) + for (i = 0; i < a1; i++) + { + int local0 = 0; + f1 (local0, i); + { + g1 (local0, i); + for (j = 0; j < a2; j++) + { + int local1 = 1; + f1 (local1, j); + { + g1 (local1, j); + for (k = 0; k < a3; k++) + { + int local2 = 2; + f1 (local2, k); + { + g1 (local2, k); + g2 (local2, k); + } + f2 (local2, k); + } + g2 (local1, j); + } + f2 (local1, j); + } + g2 (local0, i); + } + f2 (local0, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c new file mode 100644 index 00000000000..ede488977b8 --- /dev/null +++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c @@ -0,0 +1,122 @@ +/* { dg-do run } */ + +/* Like imperfect4.c, but enables offloading. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; +#pragma omp declare target enter (f1count, f2count) +#pragma omp declare target enter (g1count, g2count) + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + #pragma omp atomic + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + #pragma omp atomic + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + #pragma omp atomic + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + #pragma omp atomic + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count) + for (i = 0; i < a1; i++) + { + { f1 (0, i); } + { + g1 (0, i); + for (j = 0; j < a2; j++) + { + { f1 (1, j); } + { + { g1 (1, j); } + for (k = 0; k < a3; k++) + { + f1 (2, k); + { + g1 (2, k); + g2 (2, k); + } + f2 (2, k); + } + { g2 (1, j); } + } + { f2 (1, j); } + } + { g2 (0, i); } + } + { f2 (0, i); } + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} From patchwork Fri Apr 28 23:22:53 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 1775176 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4Q7TFD2yDVz23vP for ; Sat, 29 Apr 2023 09:23:44 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5C5783856246 for ; Fri, 28 Apr 2023 23:23:42 +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 43F483858C50 for ; Fri, 28 Apr 2023 23:23:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 43F483858C50 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.99,235,1677571200"; d="scan'208";a="3821649" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 28 Apr 2023 15:23:16 -0800 IronPort-SDR: WnUpkp8h1cLkc7IlhqDMEqFDAOIOxCZa4xWvd4KSWiqHt0lbxtUlvZFpxTOBrtMtoGaLtTksPf 3UKzeIxn7ShllQMM9/U91LHgfU2q2MRIlSxXxwXkj/42EeAbE595fH2d5Krnhz0cq3/iXtnhhJ qeX2o0jpn11ms/CQHO/1U/ZouFjMSzShwQFrdmcmdAJvqhGklqaSePCwAS9SC9Jr4oDX/5OAJh LXaoryqOLmJzc0qv5cEoqmU+GQLhspMpeiAFPPeJBEgZ/90/2xiMFmOC4vlHthJzxQn7l02jWb e5U= From: Sandra Loosemore To: Subject: [PATCH 2/3] OpenMP: C++ support for imperfectly-nested loops Date: Fri, 28 Apr 2023 17:22:53 -0600 Message-ID: <20230428232254.628185-3-sandra@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20230428232254.628185-1-sandra@codesourcery.com> References: <20230428232254.628185-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-12.mgc.mentorg.com (147.34.90.212) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-9.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" OpenMP 5.0 removed the restriction that multiple collapsed loops must be perfectly nested, allowing "intervening code" (including nested BLOCKs) before or after each nested loop. In GCC this code is moved into the inner loop body by the respective front ends. This patch changes the C++ front end to use recursive descent parsing on nested loops within an "omp for" construct, rather than an iterative approach, in order to preserve proper nesting of compound statements. Preserving cleanups (destructors) for class objects declared in intervening code and loop initializers complicates moving the former into the body of the loop; this is handled by parsing the entire construct before reassembling any of it. gcc/cp/ChangeLog * cp-tree.h (cp_convert_omp_range_for): Adjust declaration. * parser.cc (struct omp_for_parse_data): New. (cp_parser_postfix_expression): Diagnose calls to OpenMP runtime in intervening code. (cp_parser_statement_seq_opt): Special-case nested OMP loops and blocks in intervening code. (cp_parser_iteration_statement): Reject loops in intervening code. (cp_parser_omp_for_loop_init): Expand comments and tweak the interface slightly to better distinguish input/output parameters. (cp_parser_omp_range_for): Likewise. (cp_convert_omp_range_for): Likewise. (cp_parser_omp_loop_nest): New, split from cp_parser_omp_for_loop and largely rewritten. Add more comments. (struct sit_data, substitute_in_tree_walker, substitute_in_tree): New. (fixup_blocks_walker): New. (cp_parser_omp_for_loop): Rewrite to use recursive descent instead of a loop. Add logic to reshuffle the bits of code collected during parsing so intervening code gets moved to the loop body. (cp_parser_omp_loop): Remove call to finish_omp_for_block, which is now redundant. (cp_parser_omp_simd): Likewise. (cp_parser_omp_for): Likewise. (cp_parser_omp_distribute): Likewise. (cp_parser_oacc_loop): Likewise. (cp_parser_omp_taskloop): Likewise. (cp_parser_pragma): Reject OpenMP pragmas in intervening code. * parser.h (struct cp_parser): Add omp_for_parse_state field. * pt.cc (tsubst_omp_for_iterator): Adjust call to cp_convert_omp_range_for. * semantics.cc (struct fofb_data, finish_omp_for_block_walker): New. (finish_omp_for_block): Allow variables to be bound in a BIND_EXPR nested inside BIND instead of directly in BIND itself. gcc/testsuite/ChangeLog * g++.dg/gomp/pr41967.C: Adjust expected error messages. libgomp/ChangeLog * testsuite/libgomp.c++/imperfect-class-1.C : New. * testsuite/libgomp.c++/imperfect-class-2.C : New. * testsuite/libgomp.c++/imperfect-class-3.C : New. * testsuite/libgomp.c++/imperfect-destructor.C : New. * testsuite/libgomp.c++/imperfect-template-1.C : New. * testsuite/libgomp.c++/imperfect-template-2.C : New. * testsuite/libgomp.c++/imperfect-template-3.C : New. --- gcc/cp/cp-tree.h | 2 +- gcc/cp/parser.cc | 1180 ++++++++++++----- gcc/cp/parser.h | 3 + gcc/cp/pt.cc | 3 +- gcc/cp/semantics.cc | 80 +- gcc/testsuite/g++.dg/gomp/pr41967.C | 2 +- .../testsuite/libgomp.c++/imperfect-class-1.C | 169 +++ .../testsuite/libgomp.c++/imperfect-class-2.C | 167 +++ .../testsuite/libgomp.c++/imperfect-class-3.C | 167 +++ .../libgomp.c++/imperfect-destructor.C | 135 ++ .../libgomp.c++/imperfect-template-1.C | 172 +++ .../libgomp.c++/imperfect-template-2.C | 170 +++ .../libgomp.c++/imperfect-template-3.C | 170 +++ 13 files changed, 2021 insertions(+), 399 deletions(-) create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-1.C create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-2.C create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-3.C create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-destructor.C create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-1.C create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-2.C create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-3.C diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index c9c4cd6f32f..90d369e4f65 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -7279,7 +7279,7 @@ extern bool maybe_clone_body (tree); /* In parser.cc */ extern tree cp_convert_range_for (tree, tree, tree, tree, unsigned int, bool, unsigned short); -extern void cp_convert_omp_range_for (tree &, vec *, tree &, +extern void cp_convert_omp_range_for (tree &, tree &, tree &, tree &, tree &, tree &, tree &, tree &); extern void cp_finish_omp_range_for (tree, tree); extern bool parsing_nsdmi (void); diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index d89553e7da8..33656c12138 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -2091,6 +2091,31 @@ struct cp_parser_expression_stack_entry typedef struct cp_parser_expression_stack_entry cp_parser_expression_stack[NUM_PREC_VALUES]; +/* Used for parsing OMP for loops. */ +struct omp_for_parse_data { + tree declv, condv, incrv, initv; + tree pre_body; + int collapse; + int depth; + location_t for_loc; + releasing_vec init_blockv; + releasing_vec body_blockv; + releasing_vec init_placeholderv; + releasing_vec body_placeholderv; + bool want_nested_loop : 1; + bool ordered : 1; + bool in_intervening_code : 1; + bool perfect_nesting_fail : 1; + bool fail : 1; + bool inscan : 1; + enum tree_code code; + tree orig_declv; + auto_vec orig_inits; + tree clauses; + tree *cclauses; + tree ordered_cl; +}; + /* Prototypes. */ /* Constructors and destructors. */ @@ -2912,6 +2937,7 @@ static bool cp_parser_skip_up_to_closing_square_bracket static bool cp_parser_skip_to_closing_square_bracket (cp_parser *); static size_t cp_parser_skip_balanced_tokens (cp_parser *, size_t); +static tree cp_parser_omp_loop_nest (cp_parser *, bool *); // -------------------------------------------------------------------------- // // Unevaluated Operand Guard @@ -7999,12 +8025,22 @@ cp_parser_postfix_expression (cp_parser *parser, bool address_p, bool cast_p, complain); else /* All other function calls. */ - postfix_expression - = finish_call_expr (postfix_expression, &args, - /*disallow_virtual=*/false, - koenig_p, - complain); - + { + if (DECL_P (postfix_expression) + && parser->omp_for_parse_state + && parser->omp_for_parse_state->in_intervening_code + && omp_runtime_api_call (postfix_expression)) + { + error_at (loc, "Calls to the OpenMP runtime API are " + "not permitted in intervening code"); + parser->omp_for_parse_state->fail = true; + } + postfix_expression + = finish_call_expr (postfix_expression, &args, + /*disallow_virtual=*/false, + koenig_p, + complain); + } if (close_paren_loc != UNKNOWN_LOCATION) postfix_expression.set_location (combined_loc); @@ -12969,6 +13005,15 @@ cp_parser_compound_statement (cp_parser *parser, tree in_statement_expr, static void cp_parser_statement_seq_opt (cp_parser* parser, tree in_statement_expr) { + struct omp_for_parse_data *omp_for_parse_state; + + if (parser->omp_for_parse_state + && (parser->omp_for_parse_state->depth + < parser->omp_for_parse_state->collapse - 1)) + omp_for_parse_state = parser->omp_for_parse_state; + else + omp_for_parse_state = NULL; + /* Scan statements until there aren't any more. */ while (true) { @@ -12995,6 +13040,59 @@ cp_parser_statement_seq_opt (cp_parser* parser, tree in_statement_expr) error_at (token->location, "% without a previous %"); } } + else if (omp_for_parse_state + && token->type == CPP_KEYWORD && token->keyword == RID_FOR + && omp_for_parse_state->want_nested_loop) + { + /* Special treatment for collapsed loop nests. */ + omp_for_parse_state->depth++; + add_stmt (cp_parser_omp_loop_nest (parser, NULL)); + omp_for_parse_state->depth--; + continue; + } + else if (omp_for_parse_state + && token->type != CPP_OPEN_BRACE) + { + /* Nested loops can only appear directly or nested in + compound statements. We have neither, so set the bit + to treat everything inside the subsequent statement + as intervening code instead. */ + bool want_nested_loop = omp_for_parse_state->want_nested_loop; + omp_for_parse_state->want_nested_loop = false; + + /* Only diagnose errors related to perfect nesting once. */ + if (!omp_for_parse_state->perfect_nesting_fail) + { + if (omp_for_parse_state->code == OACC_LOOP) + { + error_at (omp_for_parse_state->for_loc, + "inner loops must be perfectly nested in " + "%<#pragma acc loop%>"); + omp_for_parse_state->perfect_nesting_fail = true; + } + else if (omp_for_parse_state->ordered) + { + error_at (omp_for_parse_state->for_loc, + "inner loops must be perfectly nested with " + "% clause"); + omp_for_parse_state->perfect_nesting_fail = true; + } + else if (omp_for_parse_state->inscan) + { + error_at (omp_for_parse_state->for_loc, + "inner loops must be perfectly nested with " + "% % clause"); + omp_for_parse_state->perfect_nesting_fail = true; + } + /* TODO: Also reject loops with TILE directive. */ + if (omp_for_parse_state->perfect_nesting_fail) + omp_for_parse_state->fail = true; + } + + cp_parser_statement (parser, in_statement_expr, true, NULL); + omp_for_parse_state->want_nested_loop = want_nested_loop; + continue; + } /* Parse the statement. */ cp_parser_statement (parser, in_statement_expr, true, NULL); @@ -14194,6 +14292,17 @@ cp_parser_iteration_statement (cp_parser* parser, bool *if_p, bool ivdep, statement. */ in_statement = parser->in_statement; + /* Special case for OMP loop intervening code. Parsing of permitted + collapsed loop nests is handled elsewhere. */ + if (parser->omp_for_parse_state + && (parser->omp_for_parse_state->depth + < parser->omp_for_parse_state->collapse - 1)) + { + error_at (token->location, + "loop not permitted in intervening code in OMP loop body"); + parser->omp_for_parse_state->fail = true; + } + /* See what kind of keyword it is. */ keyword = token->keyword; switch (keyword) @@ -42976,7 +43085,19 @@ cp_parser_omp_for_incr (cp_parser *parser, tree decl) return build2 (MODIFY_EXPR, TREE_TYPE (decl), decl, rhs); } -/* Parse the initialization statement of an OpenMP for loop. +/* Parse the initialization statement of an OpenMP for loop. Range-for + is handled separately in cp_convert_omp_range_for. + + On entry SL is the current statement list. Parsing of some forms + of initialization pops this list and stores its contents in either INIT + or THIS_PRE_BODY, and sets SL to null. Initialization for class + iterators is added directly to SL and it is not popped until later. + + On return, DECL is set if the initialization is by binding the + iteration variable. If the initialization is by assignment, REAL_DECL + is set to point to a variable in an outer scope. ORIG_INIT is set + if the iteration variable is of class type; this is a copy saved for + error checking in finish_omp_for. Return true if the resulting construct should have an OMP_CLAUSE_PRIVATE added to it. */ @@ -42984,7 +43105,7 @@ cp_parser_omp_for_incr (cp_parser *parser, tree decl) static tree cp_parser_omp_for_loop_init (cp_parser *parser, tree &this_pre_body, - releasing_vec &for_block, + tree &sl, tree &init, tree &orig_init, tree &decl, @@ -43082,18 +43203,22 @@ cp_parser_omp_for_loop_init (cp_parser *parser, asm_specification, LOOKUP_ONLYCONVERTING); orig_init = init; + + /* In the case of a class iterator, do not pop sl here. + Both class initialization and finalization must happen in + the enclosing init block scope. For now set the init + expression to null; it'll be filled in properly in + finish_omp_for before stuffing it in the OMP_FOR. */ if (CLASS_TYPE_P (TREE_TYPE (decl))) + init = NULL_TREE; + else /* It is a parameterized type. */ { - vec_safe_push (for_block, this_pre_body); - init = NULL_TREE; - } - else - { - init = pop_stmt_list (this_pre_body); + init = pop_stmt_list (sl); + sl = NULL_TREE; if (init && TREE_CODE (init) == STATEMENT_LIST) { tree_stmt_iterator i = tsi_start (init); - /* Move lambda DECL_EXPRs to FOR_BLOCK. */ + /* Move lambda DECL_EXPRs to the enclosing block. */ while (!tsi_end_p (i)) { tree t = tsi_stmt (i); @@ -43101,7 +43226,7 @@ cp_parser_omp_for_loop_init (cp_parser *parser, && TREE_CODE (DECL_EXPR_DECL (t)) == TYPE_DECL) { tsi_delink (&i); - vec_safe_push (for_block, t); + add_stmt (t); continue; } break; @@ -43115,9 +43240,10 @@ cp_parser_omp_for_loop_init (cp_parser *parser, } } } - this_pre_body = NULL_TREE; } else + /* This is an initialized declaration of non-class, + non-parameterized type iteration variable. */ { /* Consume '='. */ cp_lexer_consume_token (parser->lexer); @@ -43131,6 +43257,8 @@ cp_parser_omp_for_loop_init (cp_parser *parser, /*init_const_expr_p=*/false, asm_specification, LOOKUP_ONLYCONVERTING); + this_pre_body = pop_stmt_list (sl); + sl = NULL_TREE; } if (pushed_scope) @@ -43202,14 +43330,21 @@ cp_parser_omp_for_loop_init (cp_parser *parser, real_decl = TREE_OPERAND (init, 0); } } + this_pre_body = pop_stmt_list (sl); + sl = NULL_TREE; } return add_private_clause; } -/* Helper for cp_parser_omp_for_loop, handle one range-for loop. */ +/* Helper for cp_parser_omp_loop_nest, handle one range-for loop + including introducing new temporaries for the range start and end, + doing auto deduction, and processing decomposition variables. + This function is also called from pt.cc during template instantiation. + In that case SL is NULL_TREE, otherwise it is the current statement + list. */ void -cp_convert_omp_range_for (tree &this_pre_body, vec *for_block, +cp_convert_omp_range_for (tree &this_pre_body, tree &sl, tree &decl, tree &orig_decl, tree &init, tree &orig_init, tree &cond, tree &incr) { @@ -43245,8 +43380,11 @@ cp_convert_omp_range_for (tree &this_pre_body, vec *for_block, cond = global_namespace; incr = NULL_TREE; orig_init = init; - if (this_pre_body) - this_pre_body = pop_stmt_list (this_pre_body); + if (sl) + { + this_pre_body = pop_stmt_list (sl); + sl = NULL_TREE; + } return; } @@ -43326,11 +43464,7 @@ cp_convert_omp_range_for (tree &this_pre_body, vec *for_block, orig_decl = decl; decl = begin; - if (for_block) - { - vec_safe_push (for_block, this_pre_body); - this_pre_body = NULL_TREE; - } + /* Defer popping sl here. */ tree decomp_first_name = NULL_TREE; unsigned decomp_cnt = 0; @@ -43368,6 +43502,15 @@ cp_convert_omp_range_for (tree &this_pre_body, vec *for_block, } } + /* The output ORIG_DECL is not a decl. Instead, it is a tree structure + that holds decls for variables implementing the iterator, represented + as a TREE_LIST whose TREE_CHAIN is a vector. The first two elements + of the vector are decls of scratch variables for the range start and + end that will eventually be bound in the implicit scope surrounding + the whole loop nest. The remaining elements are decls of derived + decomposition variables that are bound inside the loop body. This + structure is further mangled by finish_omp_for into the form required + for the OMP_FOR_ORIG_DECLS field of the OMP_FOR tree node. */ tree v = make_tree_vec (decomp_cnt + 3); TREE_VEC_ELT (v, 0) = range_temp_decl; TREE_VEC_ELT (v, 1) = end; @@ -43622,404 +43765,686 @@ cp_parser_omp_scan_loop_body (cp_parser *parser) braces.require_close (parser); } -/* Parse the restricted form of the for statement allowed by OpenMP. */ + +/* This function parses a single level of a loop nest, invoking itself + recursively if necessary. + + loop-nest :: for (...) loop-body + loop-body :: loop-nest + | { [intervening-code] loop-body [intervening-code] } + | final-loop-body + intervening-code :: structured-block-sequence + final-loop-body :: structured-block + + For a collapsed loop nest, only a single OMP_FOR is built, pulling out + all the iterator information from the inner loops into vectors in the + parser->omp_for_parse_state structure. + + In the "range for" case, it is transformed into a regular "for" iterator + by introducing some temporary variables for the begin/end, + as well as bindings of the actual iteration variables which are + injected into the body of the loop. + + Initialization code for iterator variables may end up either in the + init vector (simple assignments), in omp_for_parse_state->pre_body + (decl_exprs for iterators bound in the for statement), or in the + scope surrounding this level of loop initialization. + + The scopes of class iterator variables and their finalizers need to + be adjusted after parsing so that all of the initialization happens + in a scope surrounding all of the intervening and body code. For + this reason we separately store the initialization and body blocks + for each level of loops in the omp_for_parse_state structure and + reassemble/reorder them in cp_parser_omp_for. See additional + comments there about the use of placeholders, etc. */ static tree -cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses, - tree *cclauses, bool *if_p) -{ - tree init, orig_init, cond, incr, body, decl, pre_body = NULL_TREE, ret; - tree orig_decl; - tree real_decl, initv, condv, incrv, declv, orig_declv; - tree this_pre_body, cl, ordered_cl = NULL_TREE; - location_t loc_first; - bool collapse_err = false; - int i, collapse = 1, ordered = 0, count, nbraces = 0; - releasing_vec for_block; - auto_vec orig_inits; - bool tiling = false; - bool inscan = false; +cp_parser_omp_loop_nest (cp_parser *parser, bool *if_p) +{ + tree decl, cond, incr, init; + tree orig_init, real_decl, orig_decl; + tree init_block, body_block; + tree init_placeholder, body_placeholder; + tree init_scope; + tree this_pre_body = NULL_TREE; + bool moreloops; + unsigned char save_in_statement; + tree add_private_clause = NULL_TREE; + location_t loc; + bool is_range_for = false; + tree sl = NULL_TREE; + struct omp_for_parse_data *omp_for_parse_state = parser->omp_for_parse_state; - for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl)) - if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE) - collapse = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (cl)); - else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_TILE) - { - tiling = true; - collapse = list_length (OMP_CLAUSE_TILE_LIST (cl)); - } - else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_ORDERED - && OMP_CLAUSE_ORDERED_EXPR (cl)) - { - ordered_cl = cl; - ordered = tree_to_shwi (OMP_CLAUSE_ORDERED_EXPR (cl)); - } - else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_REDUCTION - && OMP_CLAUSE_REDUCTION_INSCAN (cl) - && (code == OMP_SIMD || code == OMP_FOR)) - inscan = true; + gcc_assert (omp_for_parse_state); - if (ordered && ordered < collapse) - { - error_at (OMP_CLAUSE_LOCATION (ordered_cl), - "% clause parameter is less than %"); - OMP_CLAUSE_ORDERED_EXPR (ordered_cl) - = build_int_cst (NULL_TREE, collapse); - ordered = collapse; - } + /* We have already matched the FOR token but not consumed it yet. */ + gcc_assert (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)); + loc = cp_lexer_consume_token (parser->lexer)->location; - gcc_assert (tiling || (collapse >= 1 && ordered >= 0)); - count = ordered ? ordered : collapse; + /* Forbid break/continue in the loop initializer, condition, and + increment expressions. */ + save_in_statement = parser->in_statement; + parser->in_statement = IN_OMP_BLOCK; - declv = make_tree_vec (count); - initv = make_tree_vec (count); - condv = make_tree_vec (count); - incrv = make_tree_vec (count); - orig_declv = NULL_TREE; + /* We are not in intervening code now. */ + omp_for_parse_state->in_intervening_code = false; - loc_first = cp_lexer_peek_token (parser->lexer)->location; + /* Don't create location wrapper nodes within an OpenMP "for" + statement. */ + auto_suppress_location_wrappers sentinel; - for (i = 0; i < count; i++) - { - int bracecount = 0; - tree add_private_clause = NULL_TREE; - location_t loc; + matching_parens parens; + if (!parens.require_open (parser)) + return NULL; - if (!cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)) - { - if (!collapse_err) - cp_parser_error (parser, "for statement expected"); - return NULL; - } - loc = cp_lexer_consume_token (parser->lexer)->location; + init = orig_init = decl = real_decl = orig_decl = NULL_TREE; - /* Don't create location wrapper nodes within an OpenMP "for" - statement. */ - auto_suppress_location_wrappers sentinel; + init_placeholder = build_stmt (input_location, EXPR_STMT, + integer_zero_node); + vec_safe_push (omp_for_parse_state->init_placeholderv, init_placeholder); - matching_parens parens; - if (!parens.require_open (parser)) - return NULL; + /* The init_block acts as a container for this level of loop goo. */ + init_block = push_stmt_list (); + vec_safe_push (omp_for_parse_state->init_blockv, init_block); - init = orig_init = decl = real_decl = orig_decl = NULL_TREE; - this_pre_body = push_stmt_list (); + /* Wrap a scope around this entire level of loop to hold bindings + of loop iteration variables. We can't insert them directly + in the containing scope because that would cause their visibility to + be incorrect with respect to intervening code after this loop. + We will combine the nested init_scopes in postprocessing after the + entire loop is parsed. */ + init_scope = begin_compound_stmt (0); - if (code != OACC_LOOP && cxx_dialect >= cxx11) - { - /* Save tokens so that we can put them back. */ - cp_lexer_save_tokens (parser->lexer); + /* Now we need another level of statement list container to capture the + initialization (and possible finalization) bits. In some cases this + container may be popped off during initializer parsing to store code in + INIT or THIS_PRE_BODY, depending on the form of initialization. If + we have a class iterator we will pop it at the end of parsing this + level, so the cleanups are handled correctly. */ + sl = push_stmt_list (); - /* Look for ':' that is not nested in () or {}. */ - bool is_range_for - = (cp_parser_skip_to_closing_parenthesis_1 (parser, - /*recovering=*/false, - CPP_COLON, - /*consume_paren=*/ - false) == -1); + if (omp_for_parse_state->code != OACC_LOOP && cxx_dialect >= cxx11) + { + /* Save tokens so that we can put them back. */ + cp_lexer_save_tokens (parser->lexer); - /* Roll back the tokens we skipped. */ - cp_lexer_rollback_tokens (parser->lexer); + /* Look for ':' that is not nested in () or {}. */ + is_range_for + = (cp_parser_skip_to_closing_parenthesis_1 (parser, + /*recovering=*/false, + CPP_COLON, + /*consume_paren=*/ + false) == -1); - if (is_range_for) - { - bool saved_colon_corrects_to_scope_p - = parser->colon_corrects_to_scope_p; + /* Roll back the tokens we skipped. */ + cp_lexer_rollback_tokens (parser->lexer); - /* A colon is used in range-based for. */ - parser->colon_corrects_to_scope_p = false; + if (is_range_for) + { + bool saved_colon_corrects_to_scope_p + = parser->colon_corrects_to_scope_p; - /* Parse the declaration. */ - cp_parser_simple_declaration (parser, - /*function_definition_allowed_p=*/ - false, &decl); - parser->colon_corrects_to_scope_p - = saved_colon_corrects_to_scope_p; + /* A colon is used in range-based for. */ + parser->colon_corrects_to_scope_p = false; - cp_parser_require (parser, CPP_COLON, RT_COLON); + /* Parse the declaration. */ + cp_parser_simple_declaration (parser, + /*function_definition_allowed_p=*/ + false, &decl); + parser->colon_corrects_to_scope_p + = saved_colon_corrects_to_scope_p; - init = cp_parser_range_for (parser, NULL_TREE, NULL_TREE, decl, - false, 0, true); + cp_parser_require (parser, CPP_COLON, RT_COLON); - cp_convert_omp_range_for (this_pre_body, for_block, decl, - orig_decl, init, orig_init, - cond, incr); - if (this_pre_body) - { - if (pre_body) - { - tree t = pre_body; - pre_body = push_stmt_list (); - add_stmt (t); - add_stmt (this_pre_body); - pre_body = pop_stmt_list (pre_body); - } - else - pre_body = this_pre_body; - } + init = cp_parser_range_for (parser, NULL_TREE, NULL_TREE, decl, + false, 0, true); - if (ordered_cl) - error_at (OMP_CLAUSE_LOCATION (ordered_cl), - "% clause with parameter on " - "range-based % loop"); + cp_convert_omp_range_for (this_pre_body, sl, decl, + orig_decl, init, orig_init, + cond, incr); - goto parse_close_paren; - } + if (omp_for_parse_state->ordered_cl) + error_at (OMP_CLAUSE_LOCATION (omp_for_parse_state->ordered_cl), + "% clause with parameter on " + "range-based % loop"); + + goto parse_close_paren; } + } - add_private_clause - = cp_parser_omp_for_loop_init (parser, this_pre_body, for_block, - init, orig_init, decl, real_decl); + add_private_clause + = cp_parser_omp_for_loop_init (parser, this_pre_body, sl, + init, orig_init, decl, real_decl); - cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON); - if (this_pre_body) - { - this_pre_body = pop_stmt_list (this_pre_body); - if (pre_body) - { - tree t = pre_body; - pre_body = push_stmt_list (); - add_stmt (t); - add_stmt (this_pre_body); - pre_body = pop_stmt_list (pre_body); - } - else - pre_body = this_pre_body; - } + cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON); - if (decl) - real_decl = decl; - if (cclauses != NULL - && cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL - && real_decl != NULL_TREE - && code != OMP_LOOP) - { - tree *c; - for (c = &cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]; *c ; ) - if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_FIRSTPRIVATE - && OMP_CLAUSE_DECL (*c) == real_decl) - { - error_at (loc, "iteration variable %qD" - " should not be firstprivate", real_decl); - *c = OMP_CLAUSE_CHAIN (*c); - } - else if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_LASTPRIVATE - && OMP_CLAUSE_DECL (*c) == real_decl) + /* If the iteration variable was introduced via a declaration in the + for statement, DECL points at it. Otherwise DECL is null and + REAL_DECL is a variable previously declared in an outer scope. + Make REAL_DECL point at the iteration variable no matter where it + was introduced. */ + if (decl) + real_decl = decl; + + /* Some clauses treat iterator variables specially. */ + if (omp_for_parse_state->cclauses != NULL + && omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL + && real_decl != NULL_TREE + && omp_for_parse_state->code != OMP_LOOP) + { + tree *c; + for (c = &(omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]); + *c ; ) + if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_FIRSTPRIVATE + && OMP_CLAUSE_DECL (*c) == real_decl) + { + error_at (loc, "iteration variable %qD" + " should not be firstprivate", real_decl); + *c = OMP_CLAUSE_CHAIN (*c); + } + else if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_LASTPRIVATE + && OMP_CLAUSE_DECL (*c) == real_decl) + { + /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES. */ + tree l = *c; + *c = OMP_CLAUSE_CHAIN (*c); + if (omp_for_parse_state->code == OMP_SIMD) { - /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES. */ - tree l = *c; - *c = OMP_CLAUSE_CHAIN (*c); - if (code == OMP_SIMD) - { - OMP_CLAUSE_CHAIN (l) = cclauses[C_OMP_CLAUSE_SPLIT_FOR]; - cclauses[C_OMP_CLAUSE_SPLIT_FOR] = l; - } - else - { - OMP_CLAUSE_CHAIN (l) = clauses; - clauses = l; - } - add_private_clause = NULL_TREE; + OMP_CLAUSE_CHAIN (l) + = omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_FOR]; + omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_FOR] = l; } else { - if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_PRIVATE - && OMP_CLAUSE_DECL (*c) == real_decl) - add_private_clause = NULL_TREE; - c = &OMP_CLAUSE_CHAIN (*c); + OMP_CLAUSE_CHAIN (l) = omp_for_parse_state->clauses; + omp_for_parse_state->clauses = l; } - } + add_private_clause = NULL_TREE; + } + else + { + if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_PRIVATE + && OMP_CLAUSE_DECL (*c) == real_decl) + add_private_clause = NULL_TREE; + c = &OMP_CLAUSE_CHAIN (*c); + } + } - if (add_private_clause) + if (add_private_clause) + { + tree c; + for (c = omp_for_parse_state->clauses; c ; c = OMP_CLAUSE_CHAIN (c)) { - tree c; - for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c)) - { - if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE - || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE) - && OMP_CLAUSE_DECL (c) == decl) - break; - else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE - && OMP_CLAUSE_DECL (c) == decl) - error_at (loc, "iteration variable %qD " - "should not be firstprivate", - decl); - else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION - || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION) - && OMP_CLAUSE_DECL (c) == decl) - error_at (loc, "iteration variable %qD should not be reduction", - decl); - } - if (c == NULL) + if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE) + && OMP_CLAUSE_DECL (c) == decl) + break; + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE + && OMP_CLAUSE_DECL (c) == decl) + error_at (loc, "iteration variable %qD " + "should not be firstprivate", + decl); + else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION) + && OMP_CLAUSE_DECL (c) == decl) + error_at (loc, "iteration variable %qD should not be reduction", + decl); + } + if (c == NULL) + { + if ((omp_for_parse_state->code == OMP_SIMD + && omp_for_parse_state->collapse != 1) + || omp_for_parse_state->code == OMP_LOOP) + c = build_omp_clause (loc, OMP_CLAUSE_LASTPRIVATE); + else if (omp_for_parse_state->code != OMP_SIMD) + c = build_omp_clause (loc, OMP_CLAUSE_PRIVATE); + else + c = build_omp_clause (loc, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_DECL (c) = add_private_clause; + c = finish_omp_clauses (c, C_ORT_OMP); + if (c) { - if ((code == OMP_SIMD && collapse != 1) || code == OMP_LOOP) - c = build_omp_clause (loc, OMP_CLAUSE_LASTPRIVATE); - else if (code != OMP_SIMD) - c = build_omp_clause (loc, OMP_CLAUSE_PRIVATE); - else - c = build_omp_clause (loc, OMP_CLAUSE_LINEAR); - OMP_CLAUSE_DECL (c) = add_private_clause; - c = finish_omp_clauses (c, C_ORT_OMP); - if (c) - { - OMP_CLAUSE_CHAIN (c) = clauses; - clauses = c; - /* For linear, signal that we need to fill up - the so far unknown linear step. */ - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR) - OMP_CLAUSE_LINEAR_STEP (c) = NULL_TREE; - } + OMP_CLAUSE_CHAIN (c) = omp_for_parse_state->clauses; + omp_for_parse_state->clauses = c; + /* For linear, signal that we need to fill up + the so far unknown linear step. */ + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR) + OMP_CLAUSE_LINEAR_STEP (c) = NULL_TREE; } } + } - cond = NULL; - if (cp_lexer_next_token_is_not (parser->lexer, CPP_SEMICOLON)) - cond = cp_parser_omp_for_cond (parser, decl, code); - cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON); + cond = NULL; + if (cp_lexer_next_token_is_not (parser->lexer, CPP_SEMICOLON)) + cond = cp_parser_omp_for_cond (parser, decl, omp_for_parse_state->code); + cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON); - incr = NULL; - if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN)) - { - /* If decl is an iterator, preserve the operator on decl - until finish_omp_for. */ - if (real_decl - && ((processing_template_decl - && (TREE_TYPE (real_decl) == NULL_TREE - || !INDIRECT_TYPE_P (TREE_TYPE (real_decl)))) - || CLASS_TYPE_P (TREE_TYPE (real_decl)))) - incr = cp_parser_omp_for_incr (parser, real_decl); - else - incr = cp_parser_expression (parser); - protected_set_expr_location_if_unset (incr, input_location); - } + incr = NULL; + if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN)) + { + /* If decl is an iterator, preserve the operator on decl + until finish_omp_for. */ + if (real_decl + && ((processing_template_decl + && (TREE_TYPE (real_decl) == NULL_TREE + || !INDIRECT_TYPE_P (TREE_TYPE (real_decl)))) + || CLASS_TYPE_P (TREE_TYPE (real_decl)))) + incr = cp_parser_omp_for_incr (parser, real_decl); + else + incr = cp_parser_expression (parser); + protected_set_expr_location_if_unset (incr, input_location); + } - parse_close_paren: - if (!parens.require_close (parser)) - cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true, - /*or_comma=*/false, - /*consume_paren=*/true); + parse_close_paren: + if (!parens.require_close (parser)) + cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true, + /*or_comma=*/false, + /*consume_paren=*/true); - TREE_VEC_ELT (declv, i) = decl; - TREE_VEC_ELT (initv, i) = init; - TREE_VEC_ELT (condv, i) = cond; - TREE_VEC_ELT (incrv, i) = incr; - if (orig_init) - { - orig_inits.safe_grow_cleared (i + 1, true); - orig_inits[i] = orig_init; - } - if (orig_decl) + /* We've parsed all the for (...) stuff now. Store the bits. */ + TREE_VEC_ELT (omp_for_parse_state->declv, omp_for_parse_state->depth) + = decl; + TREE_VEC_ELT (omp_for_parse_state->initv, omp_for_parse_state->depth) + = init; + TREE_VEC_ELT (omp_for_parse_state->condv, omp_for_parse_state->depth) + = cond; + TREE_VEC_ELT (omp_for_parse_state->incrv, omp_for_parse_state->depth) + = incr; + if (orig_init) + { + int i = omp_for_parse_state->depth; + omp_for_parse_state->orig_inits.safe_grow_cleared (i + 1, true); + omp_for_parse_state->orig_inits[i] = orig_init; + } + if (orig_decl) + { + if (!omp_for_parse_state->orig_declv) + omp_for_parse_state->orig_declv + = copy_node (omp_for_parse_state->declv); + TREE_VEC_ELT (omp_for_parse_state->orig_declv, + omp_for_parse_state->depth) = orig_decl; + } + else if (omp_for_parse_state->orig_declv) + TREE_VEC_ELT (omp_for_parse_state->orig_declv, + omp_for_parse_state->depth) = decl; + if (this_pre_body) + append_to_statement_list_force (this_pre_body, + &(omp_for_parse_state->pre_body)); + + /* Start a nested block for the loop body. */ + body_placeholder = build_stmt (input_location, EXPR_STMT, + integer_zero_node); + vec_safe_push (omp_for_parse_state->body_placeholderv, body_placeholder); + body_block = push_stmt_list (); + vec_safe_push (omp_for_parse_state->body_blockv, body_block); + + omp_for_parse_state->want_nested_loop = true; + moreloops = omp_for_parse_state->depth < omp_for_parse_state->collapse - 1; + if (moreloops && cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)) + { + omp_for_parse_state->depth++; + add_stmt (cp_parser_omp_loop_nest (parser, if_p)); + omp_for_parse_state->depth--; + } + else if (moreloops + && cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE)) + { + /* This is the open brace in the loop-body grammar production. Rather + than trying to special-case braces, just parse it as a compound + statement and handle the nested loop-body case there. Note that + when we see a further open brace inside the compound statement + loop-body, we don't know whether it is the start of intervening + code that is a compound statement, or a level of braces + surrounding a nested loop-body. Use the WANT_NESTED_LOOP state + bit to ensure we have only one nested loop at each level. */ + + omp_for_parse_state->in_intervening_code = true; + cp_parser_compound_statement (parser, NULL, BCS_NORMAL, false); + omp_for_parse_state->in_intervening_code = false; + + if (omp_for_parse_state->want_nested_loop) { - if (!orig_declv) - orig_declv = copy_node (declv); - TREE_VEC_ELT (orig_declv, i) = orig_decl; + /* We have already parsed the whole loop body and not found a + nested loop. */ + error_at (omp_for_parse_state->for_loc, + "not enough nested loops"); + omp_for_parse_state->fail = true; } - else if (orig_declv) - TREE_VEC_ELT (orig_declv, i) = decl; + if_p = NULL; + } + else + { + /* This is the final-loop-body case in the grammar: we have something + that is not a FOR and not an open brace. */ + if (moreloops) + { + /* If we were expecting a nested loop, give an error and mark + that parsing has failed, and try to recover by parsing the + body as regular code without further collapsing. */ + error_at (omp_for_parse_state->for_loc, + "not enough nested loops"); + omp_for_parse_state->fail = true; + } + parser->in_statement = IN_OMP_FOR; + + /* Generate the parts of range for that belong in the loop body, + to be executed on every iteration. This includes setting the + user-declared decomposition variables from the compiler-generated + temporaries that are the real iteration variables for OMP_FOR. + FIXME: Not sure if this is correct with respect to visibility + of the variables from intervening code. However, putting this + code in each level of loop instead of all around the innermost + body also makes the decomposition variables visible to the + inner for init/bound/step exressions, which is not supposed to + happen and causes test failures. */ + if (omp_for_parse_state->orig_declv) + for (int i = 0; i < omp_for_parse_state->collapse; i++) + { + tree o = TREE_VEC_ELT (omp_for_parse_state->orig_declv, i); + tree d = TREE_VEC_ELT (omp_for_parse_state->declv, i); + if (o != d) + cp_finish_omp_range_for (o, d); + } - if (i == count - 1) - break; + /* Now parse the final-loop-body for the innermost loop. */ + if (omp_for_parse_state->inscan) + cp_parser_omp_scan_loop_body (parser); + else + cp_parser_statement (parser, NULL_TREE, false, if_p); + } + parser->in_statement = save_in_statement; + omp_for_parse_state->want_nested_loop = false; + omp_for_parse_state->in_intervening_code = true; + + /* Pop and remember the body block. Add the body placeholder + to the surrounding statement list instead. This is just a unique + token that will be replaced when we reassemble the generated + code for the entire omp for statement. */ + body_block = pop_stmt_list (body_block); + omp_for_parse_state->body_blockv[omp_for_parse_state->depth] = body_block; + add_stmt (body_placeholder); + + /* Pop and remember the init block. */ + if (sl) + add_stmt (pop_stmt_list (sl)); + finish_compound_stmt (init_scope); + init_block = pop_stmt_list (init_block); + omp_for_parse_state->init_blockv[omp_for_parse_state->depth] = init_block; + + /* Return the init placeholder rather than the remembered init block. + Again, this is just a unique cookie that will be used to reassemble + code pieces when the entire omp for statement has been parsed. */ + return init_placeholder; +} + +/* Helpers used for relinking tree structures: In tree rooted at + CONTEXT, replace ORIG with REPLACEMENT. If FLATTEN is true, try to combine + nested BIND_EXPRs. Gives an assertion if it fails to find ORIG. */ + +struct sit_data { + tree orig; + tree repl; + bool flatten; +}; - /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed - in between the collapsed for loops to be still considered perfectly - nested. Hopefully the final version clarifies this. - For now handle (multiple) {'s and empty statements. */ - cp_parser_parse_tentatively (parser); - for (;;) - { - if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)) - break; - else if (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE)) - { - cp_lexer_consume_token (parser->lexer); - bracecount++; - } - else if (bracecount - && cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON)) - cp_lexer_consume_token (parser->lexer); - else - { - loc = cp_lexer_peek_token (parser->lexer)->location; - error_at (loc, "not enough for loops to collapse"); - collapse_err = true; - cp_parser_abort_tentative_parse (parser); - declv = NULL_TREE; - break; - } - } +static tree +substitute_in_tree_walker (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, void *dp) +{ + struct sit_data *sit = (struct sit_data *)dp; + if (*tp == sit->orig) + { + *tp = sit->repl; + return *tp; + } + /* Remove BIND_EXPRs with no bindings even when not specifically + trying to flatten. */ + else if (TREE_CODE (*tp) == BIND_EXPR + && BIND_EXPR_BODY (*tp) == sit->orig + && !BIND_EXPR_VARS (*tp)) + { + *tp = sit->repl; + return *tp; + } + else if (sit->flatten + && TREE_CODE (*tp) == BIND_EXPR + && TREE_CODE (sit->repl) == BIND_EXPR) + { + if (BIND_EXPR_BODY (*tp) == sit->orig) + { + /* Merge binding lists for two directly nested BIND_EXPRs, + keeping the outer one. */ + BIND_EXPR_VARS (*tp) = chainon (BIND_EXPR_VARS (*tp), + BIND_EXPR_VARS (sit->repl)); + BIND_EXPR_BODY (*tp) = BIND_EXPR_BODY (sit->repl); + return *tp; + } + else if (TREE_CODE (BIND_EXPR_BODY (*tp)) == STATEMENT_LIST) + /* There might be a statement list containing cleanup_points + etc between the two levels of BIND_EXPR. We can still merge + them, again keeping the outer BIND_EXPR. */ + for (tree_stmt_iterator i = tsi_start (BIND_EXPR_BODY (*tp)); + !tsi_end_p (i); ++i) + { + tree *p = tsi_stmt_ptr (i); + if (*p == sit->orig) + { + BIND_EXPR_VARS (*tp) = chainon (BIND_EXPR_VARS (*tp), + BIND_EXPR_VARS (sit->repl)); + *p = BIND_EXPR_BODY (sit->repl); + return *tp; + } + } + } + return NULL; +} + +static void +substitute_in_tree (tree *context, tree orig, tree repl, bool flatten) +{ + struct sit_data data; + + gcc_assert (*context && orig && repl); + if (TREE_CODE (repl) == BIND_EXPR && !BIND_EXPR_VARS (repl)) + repl = BIND_EXPR_BODY (repl); + data.orig = orig; + data.repl = repl; + data.flatten = flatten; + + tree result = cp_walk_tree (context, substitute_in_tree_walker, + (void *)&data, NULL); + gcc_assert (result != NULL_TREE); +} - if (declv) +/* Walker to patch up the BLOCK_NODE hierarchy after the above surgery. + *DP is is the parent block. */ + +static tree +fixup_blocks_walker (tree *tp, int *walk_subtrees, void *dp) +{ + tree superblock = *(tree *)dp; + + if (TREE_CODE (*tp) == BIND_EXPR) + { + tree block = BIND_EXPR_BLOCK (*tp); + if (superblock) { - cp_parser_parse_definitely (parser); - nbraces += bracecount; + BLOCK_SUPERCONTEXT (block) = superblock; + BLOCK_CHAIN (block) = BLOCK_SUBBLOCKS (superblock); + BLOCK_SUBBLOCKS (superblock) = block; } + BLOCK_SUBBLOCKS (block) = NULL_TREE; + cp_walk_tree (&BIND_EXPR_BODY (*tp), fixup_blocks_walker, + (void *)&block, NULL); + *walk_subtrees = 0; } - if (nbraces) - if_p = NULL; + return NULL; +} + +/* Parse the restricted form of the for statement allowed by OpenMP. */ - /* Note that we saved the original contents of this flag when we entered - the structured block, and so we don't need to re-save it here. */ - parser->in_statement = IN_OMP_FOR; +static tree +cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses, + tree *cclauses, bool *if_p) +{ + tree ret; + tree cl, ordered_cl = NULL_TREE; + location_t loc_first; + int collapse = 1, ordered = 0; + unsigned int count; + bool tiling = false; + bool inscan = false; + struct omp_for_parse_data data; + struct omp_for_parse_data *save_data = parser->omp_for_parse_state; + tree result; - /* Note that the grammar doesn't call for a structured block here, - though the loop as a whole is a structured block. */ - if (orig_declv) + for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl)) + if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE) + collapse = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (cl)); + else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_TILE) + { + tiling = true; + collapse = list_length (OMP_CLAUSE_TILE_LIST (cl)); + } + else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_ORDERED + && OMP_CLAUSE_ORDERED_EXPR (cl)) + { + ordered_cl = cl; + ordered = tree_to_shwi (OMP_CLAUSE_ORDERED_EXPR (cl)); + } + else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_REDUCTION + && OMP_CLAUSE_REDUCTION_INSCAN (cl) + && (code == OMP_SIMD || code == OMP_FOR)) + inscan = true; + + if (ordered && ordered < collapse) { - body = begin_omp_structured_block (); - for (i = 0; i < count; i++) - if (TREE_VEC_ELT (orig_declv, i) != TREE_VEC_ELT (declv, i)) - cp_finish_omp_range_for (TREE_VEC_ELT (orig_declv, i), - TREE_VEC_ELT (declv, i)); + error_at (OMP_CLAUSE_LOCATION (ordered_cl), + "% clause parameter is less than %"); + OMP_CLAUSE_ORDERED_EXPR (ordered_cl) + = build_int_cst (NULL_TREE, collapse); + ordered = collapse; } - else - body = push_stmt_list (); - if (inscan) - cp_parser_omp_scan_loop_body (parser); - else - cp_parser_statement (parser, NULL_TREE, false, if_p); - if (orig_declv) - body = finish_omp_structured_block (body); - else - body = pop_stmt_list (body); - if (declv == NULL_TREE) - ret = NULL_TREE; - else - ret = finish_omp_for (loc_first, code, declv, orig_declv, initv, condv, - incrv, body, pre_body, &orig_inits, clauses); + gcc_assert (tiling || (collapse >= 1 && ordered >= 0)); + count = ordered ? ordered : collapse; - while (nbraces) + if (!cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)) { - if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE)) - { - cp_lexer_consume_token (parser->lexer); - nbraces--; - } - else if (cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON)) - cp_lexer_consume_token (parser->lexer); - else - { - if (!collapse_err) - { - error_at (cp_lexer_peek_token (parser->lexer)->location, - "collapsed loops not perfectly nested"); - } - collapse_err = true; - cp_parser_statement_seq_opt (parser, NULL); - if (cp_lexer_next_token_is (parser->lexer, CPP_EOF)) - break; - } + cp_parser_error (parser, "for statement expected"); + return NULL; + } + + /* FIXME: Inconsistently with the C front end, the C++ front end + uses the location of the outermost FOR loop for flagging errors, + rather than the location of the OMP FOR directive. Tweaking this + causes many failures in existing C++ test cases due to errors + being diagnosed on a different line than expected. */ + loc_first = cp_lexer_peek_token (parser->lexer)->location; + + /* Initialize parse state for recursive descent. */ + data.declv = make_tree_vec (count); + data.initv = make_tree_vec (count); + data.condv = make_tree_vec (count); + data.incrv = make_tree_vec (count); + data.pre_body = NULL_TREE; + data.for_loc = loc_first; + data.collapse = count; + data.depth = 0; + data.want_nested_loop = true; + data.ordered = ordered > 0; + data.in_intervening_code = false; + data.perfect_nesting_fail = false; + data.fail = false; + data.inscan = inscan; + data.code = code; + data.orig_declv = NULL_TREE; + data.clauses = clauses; + data.cclauses = cclauses; + data.ordered_cl = ordered_cl; + parser->omp_for_parse_state = &data; + + cp_parser_omp_loop_nest (parser, if_p); + + /* Bomb out early if there was an error (not enough loops, etc). */ + if (data.fail || data.declv == NULL_TREE) + { + parser->omp_for_parse_state = save_data; + return NULL_TREE; } - while (!for_block->is_empty ()) + /* Relink the init and body blocks that were built during parsing. At + this point we have a structure nested like + init 0 + body 0 + init 1 + body 1 + init 2 + body 2 + and we want to turn it into + init 0 + init 1 + init 2 + omp_for + body 0 + body 1 + body 2 + We also need to flatten the init blocks, as some code for later + processing of combined directives gets confused otherwise. */ + + gcc_assert (vec_safe_length (data.init_blockv) == count); + gcc_assert (vec_safe_length (data.body_blockv) == count); + gcc_assert (vec_safe_length (data.init_placeholderv) == count); + gcc_assert (vec_safe_length (data.body_placeholderv) == count); + + /* Do the substitution from the inside out. */ + for (unsigned int i = count - 1; i > 0; i--) + { + substitute_in_tree (&(data.body_blockv[i-1]), + data.init_placeholderv[i], + data.body_blockv[i], false); + substitute_in_tree (&(data.init_blockv[i-1]), + data.body_placeholderv[i-1], + data.init_blockv[i], true); + } + + /* Generate the OMP_FOR. Note finish_omp_for adds the OMP_FOR + (and possibly other stuff) to the current statement list but + returns a pointer to the OMP_FOR itself, or null in case of error. */ + result = push_stmt_list (); + ret = finish_omp_for (loc_first, code, data.declv, data.orig_declv, + data.initv, data.condv, data.incrv, + data.body_blockv[0], + data.pre_body, &data.orig_inits, data.clauses); + result = pop_stmt_list (result); + + if (ret) { - tree t = for_block->pop (); - if (TREE_CODE (t) == STATEMENT_LIST) - add_stmt (pop_stmt_list (t)); - else - add_stmt (t); + /* Splice the omp_for into the nest of init blocks. */ + substitute_in_tree (&(data.init_blockv[0]), + data.body_placeholderv[count - 1], + result, true); + + /* Some later processing for combined directives assumes + that the BIND_EXPR containing range for variables appears + at top level in the OMP_FOR body. Fix that up if it's + not the case, e.g. because there is intervening code. */ + if (code != OACC_LOOP) + finish_omp_for_block (data.init_blockv[0], ret); + + /* Clean up the block subblock/superblock links. */ + if (!processing_template_decl) + { + tree superblock = NULL_TREE; + cp_walk_tree (&data.init_blockv[0], fixup_blocks_walker, + (void *)&superblock, NULL); + } + + /* Finally record the result. */ + add_stmt (data.init_blockv[0]); } + parser->omp_for_parse_state = save_data; return ret; } @@ -44078,7 +44503,7 @@ cp_parser_omp_loop (cp_parser *parser, cp_token *pragma_tok, ret = cp_parser_omp_for_loop (parser, OMP_LOOP, clauses, cclauses, if_p); cp_parser_end_omp_structured_block (parser, save); - add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret)); + add_stmt (finish_omp_structured_block (sb)); return ret; } @@ -44127,7 +44552,7 @@ cp_parser_omp_simd (cp_parser *parser, cp_token *pragma_tok, ret = cp_parser_omp_for_loop (parser, OMP_SIMD, clauses, cclauses, if_p); cp_parser_end_omp_structured_block (parser, save); - add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret)); + add_stmt (finish_omp_structured_block (sb)); return ret; } @@ -44229,7 +44654,7 @@ cp_parser_omp_for (cp_parser *parser, cp_token *pragma_tok, ret = cp_parser_omp_for_loop (parser, OMP_FOR, clauses, cclauses, if_p); cp_parser_end_omp_structured_block (parser, save); - add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret)); + add_stmt (finish_omp_structured_block (sb)); return ret; } @@ -45077,7 +45502,7 @@ cp_parser_omp_distribute (cp_parser *parser, cp_token *pragma_tok, ret = cp_parser_omp_for_loop (parser, OMP_DISTRIBUTE, clauses, NULL, if_p); cp_parser_end_omp_structured_block (parser, save); - add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret)); + add_stmt (finish_omp_structured_block (sb)); return ret; } @@ -46084,7 +46509,15 @@ cp_parser_oacc_loop (cp_parser *parser, cp_token *pragma_tok, char *p_name, int save = cp_parser_begin_omp_structured_block (parser); tree stmt = cp_parser_omp_for_loop (parser, OACC_LOOP, clauses, NULL, if_p); cp_parser_end_omp_structured_block (parser, save); - add_stmt (finish_omp_structured_block (block)); + + /* Later processing of combined acc loop constructs gets confused + by an extra level of empty nested BIND_EXPRs, so flatten them. */ + block = finish_omp_structured_block (block); + if (TREE_CODE (block) == BIND_EXPR + && TREE_CODE (BIND_EXPR_BODY (block)) == BIND_EXPR + && !BIND_EXPR_VARS (block)) + block = BIND_EXPR_BODY (block); + add_stmt (block); return stmt; } @@ -48436,7 +48869,7 @@ cp_parser_omp_taskloop (cp_parser *parser, cp_token *pragma_tok, if_p); cp_parser_end_omp_structured_block (parser, save); - add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret)); + add_stmt (finish_omp_structured_block (sb)); return ret; } @@ -49211,6 +49644,17 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p) parser->lexer->in_pragma = true; id = cp_parser_pragma_kind (pragma_tok); + if (parser->omp_for_parse_state + && parser->omp_for_parse_state->in_intervening_code + && id >= PRAGMA_OMP__START_ + && id <= PRAGMA_OMP__LAST_) + { + error_at (pragma_tok->location, + "intervening code must not contain OpenMP directives"); + parser->omp_for_parse_state->fail = true; + cp_parser_skip_to_pragma_eol (parser, pragma_tok); + return false; + } if (id != PRAGMA_OMP_DECLARE && id != PRAGMA_OACC_ROUTINE) cp_ensure_no_omp_declare_simd (parser); switch (id) diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h index e261d7e16e4..6cbb9a8e031 100644 --- a/gcc/cp/parser.h +++ b/gcc/cp/parser.h @@ -435,6 +435,9 @@ struct GTY(()) cp_parser { specification, if any, or UNKNOWN_LOCATION otherwise. */ location_t innermost_linkage_specification_location; + /* Pointer to state for parsing omp_loops. Managed by + cp_parser_omp_for_loop in parser.cc and not used outside that file. */ + struct omp_for_parse_data * GTY((skip)) omp_for_parse_state; }; /* In parser.cc */ diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index 6df16fef0dd..2f1f9235bf2 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -18448,7 +18448,8 @@ tsubst_omp_for_iterator (tree t, int i, tree declv, tree &orig_declv, tree this_pre_body = NULL_TREE; tree orig_init = NULL_TREE; tree orig_decl = NULL_TREE; - cp_convert_omp_range_for (this_pre_body, NULL, decl, orig_decl, init, + tree init_sl = NULL_TREE; + cp_convert_omp_range_for (this_pre_body, init_sl, decl, orig_decl, init, orig_init, cond, incr); if (orig_decl) { diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc index 9ba316ab3be..8662e4f500d 100644 --- a/gcc/cp/semantics.cc +++ b/gcc/cp/semantics.cc @@ -10818,47 +10818,71 @@ finish_omp_for (location_t locus, enum tree_code code, tree declv, return omp_for; } -/* Fix up range for decls. Those decls were pushed into BIND's BIND_EXPR_VARS - and need to be moved into the BIND_EXPR inside of the OMP_FOR's body. */ +/* Code walker for finish_omp_for_block: extract binding of DP->var + from its current block and move it to a new BIND_EXPR DP->b + surrounding the body of DP->omp_for. */ +struct fofb_data { + tree var; + tree b; + tree omp_for; +}; + +static tree +finish_omp_for_block_walker (tree *tp, int *walk_subtrees, void *dp) +{ + struct fofb_data *fofb = (struct fofb_data *)dp; + if (TREE_CODE (*tp) == BIND_EXPR) + for (tree *p = &BIND_EXPR_VARS (*tp); *p; p = &DECL_CHAIN (*p)) + { + if (*p == fofb->var) + { + *p = DECL_CHAIN (*p); + if (fofb->b == NULL_TREE) + { + fofb->b = make_node (BLOCK); + fofb->b = build3 (BIND_EXPR, void_type_node, NULL_TREE, + OMP_FOR_BODY (fofb->omp_for), fofb->b); + TREE_SIDE_EFFECTS (fofb->b) = 1; + OMP_FOR_BODY (fofb->omp_for) = fofb->b; + } + DECL_CHAIN (fofb->var) = BIND_EXPR_VARS (fofb->b); + BIND_EXPR_VARS (fofb->b) = fofb->var; + BLOCK_VARS (BIND_EXPR_BLOCK (fofb->b)) = fofb->var; + BLOCK_VARS (BIND_EXPR_BLOCK (*tp)) = BIND_EXPR_VARS (*tp); + return *tp; + } + } + if (TREE_CODE (*tp) != BIND_EXPR && TREE_CODE (*tp) != STATEMENT_LIST) + *walk_subtrees = false; + return NULL_TREE; +} + +/* Fix up range for decls. Those decls were pushed into BIND's + BIND_EXPR_VARS, or that of a nested BIND_EXPR inside its body, + and need to be moved into a new BIND_EXPR surrounding OMP_FOR's body + so that processing of combined loop directives can find them. */ tree finish_omp_for_block (tree bind, tree omp_for) { if (omp_for == NULL_TREE || !OMP_FOR_ORIG_DECLS (omp_for) - || bind == NULL_TREE - || TREE_CODE (bind) != BIND_EXPR) + || bind == NULL_TREE) return bind; - tree b = NULL_TREE; + struct fofb_data fofb; + fofb.b = NULL_TREE; + fofb.omp_for = omp_for; for (int i = 0; i < TREE_VEC_LENGTH (OMP_FOR_INIT (omp_for)); i++) if (TREE_CODE (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i)) == TREE_LIST && TREE_CHAIN (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i))) { tree v = TREE_CHAIN (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i)); - gcc_assert (BIND_EXPR_BLOCK (bind) - && (BIND_EXPR_VARS (bind) - == BLOCK_VARS (BIND_EXPR_BLOCK (bind)))); for (int j = 2; j < TREE_VEC_LENGTH (v); j++) - for (tree *p = &BIND_EXPR_VARS (bind); *p; p = &DECL_CHAIN (*p)) - { - if (*p == TREE_VEC_ELT (v, j)) - { - tree var = *p; - *p = DECL_CHAIN (*p); - if (b == NULL_TREE) - { - b = make_node (BLOCK); - b = build3 (BIND_EXPR, void_type_node, NULL_TREE, - OMP_FOR_BODY (omp_for), b); - TREE_SIDE_EFFECTS (b) = 1; - OMP_FOR_BODY (omp_for) = b; - } - DECL_CHAIN (var) = BIND_EXPR_VARS (b); - BIND_EXPR_VARS (b) = var; - BLOCK_VARS (BIND_EXPR_BLOCK (b)) = var; - } - } - BLOCK_VARS (BIND_EXPR_BLOCK (bind)) = BIND_EXPR_VARS (bind); + { + fofb.var = TREE_VEC_ELT (v, j); + cp_walk_tree (&bind, finish_omp_for_block_walker, + (void *)&fofb, NULL); + } } return bind; } diff --git a/gcc/testsuite/g++.dg/gomp/pr41967.C b/gcc/testsuite/g++.dg/gomp/pr41967.C index 0eb489e8bee..7b59f831fe0 100644 --- a/gcc/testsuite/g++.dg/gomp/pr41967.C +++ b/gcc/testsuite/g++.dg/gomp/pr41967.C @@ -11,7 +11,7 @@ foo () { for (int j = 0; j < 5; ++j) ++sum; - ++sum; // { dg-error "collapsed loops not perfectly nested" } + ++sum; } return sum; } diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-1.C b/libgomp/testsuite/libgomp.c++/imperfect-class-1.C new file mode 100644 index 00000000000..3c39c42c107 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-class-1.C @@ -0,0 +1,169 @@ +// { dg-do run } +// Test that class iterators and imperfectly-nested loops work together. +// This variant tests initialization by assignment. + +typedef __PTRDIFF_TYPE__ ptrdiff_t; +typedef int T; +typedef int S; + +class I +{ +public: + typedef ptrdiff_t difference_type; + I (); + ~I (); + I (T *); + I (const I &); + T &operator * (); + T *operator -> (); + T &operator [] (const difference_type &) const; + I &operator = (const I &); + I &operator ++ (); + I operator ++ (int); + I &operator -- (); + I operator -- (int); + I &operator += (const difference_type &); + I &operator -= (const difference_type &); + I operator + (const difference_type &) const; + I operator - (const difference_type &) const; + friend bool operator == (I &, I &); + friend bool operator == (const I &, const I &); + friend bool operator < (I &, I &); + friend bool operator < (const I &, const I &); + friend bool operator <= (I &, I &); + friend bool operator <= (const I &, const I &); + friend bool operator > (I &, I &); + friend bool operator > (const I &, const I &); + friend bool operator >= (I &, I &); + friend bool operator >= (const I &, const I &); + friend typename I::difference_type operator - (I &, I &); + friend typename I::difference_type operator - (const I &, const I &); + friend I operator + (typename I::difference_type , const I &); +private: + T *p; +}; + I::I () : p (0) {} + I::~I () { p = (T *) 0; } + I::I (T *x) : p (x) {} + I::I (const I &x) : p (x.p) {} + T &I::operator * () { return *p; } + T *I::operator -> () { return p; } + T &I::operator [] (const difference_type &x) const { return p[x]; } + I &I::operator = (const I &x) { p = x.p; return *this; } + I &I::operator ++ () { ++p; return *this; } + I I::operator ++ (int) { return I (p++); } + I &I::operator -- () { --p; return *this; } + I I::operator -- (int) { return I (p--); } + I &I::operator += (const difference_type &x) { p += x; return *this; } + I &I::operator -= (const difference_type &x) { p -= x; return *this; } + I I::operator + (const difference_type &x) const { return I (p + x); } + I I::operator - (const difference_type &x) const { return I (p - x); } + bool operator == (I &x, I &y) { return x.p == y.p; } + bool operator == (const I &x, const I &y) { return x.p == y.p; } + bool operator != (I &x, I &y) { return !(x == y); } + bool operator != (const I &x, const I &y) { return !(x == y); } + bool operator < (I &x, I &y) { return x.p < y.p; } + bool operator < (const I &x, const I &y) { return x.p < y.p; } + bool operator <= (I &x, I &y) { return x.p <= y.p; } + bool operator <= (const I &x, const I &y) { return x.p <= y.p; } + bool operator > (I &x, I &y) { return x.p > y.p; } + bool operator > (const I &x, const I &y) { return x.p > y.p; } + bool operator >= (I &x, I &y) { return x.p >= y.p; } + bool operator >= (const I &x, const I &y) { return x.p >= y.p; } + typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; } + typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; } + I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); } + +class J +{ + public: + J(const I &x, const I &y) : b (x), e (y) {} + const I &begin (); + const I &end (); + private: + I b, e; +}; + +const I &J::begin () { return b; } +const I &J::end () { return e; } + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +void f1 (int depth) +{ + f1count[depth]++; +} + +void f2 (int depth) +{ + f2count[depth]++; +} + +void s1 (J a1, J a2, J a3) +{ + I i, j, k; + +#pragma omp for collapse(3) + for (i = a1.begin (); i < a1.end (); i++) + { + f1 (0); + for (j = a2.begin (); j < a2.end (); j++) + { + f1 (1); + for (k = a3.begin (); k < a3.end (); k++) + { + f1 (2); + f2 (2); + } + f2 (1); + } + f2 (0); + } +} + + +int +main (void) +{ + + int index[] = {0, 1, 2, 3, 4, 5}; + + J x (&index[0], &index[3]); + J y (&index[0], &index[4]); + J z (&index[0], &index[5]); + + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (x, y, z); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-2.C b/libgomp/testsuite/libgomp.c++/imperfect-class-2.C new file mode 100644 index 00000000000..c6b657cabba --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-class-2.C @@ -0,0 +1,167 @@ +// { dg-do run } +// Test that class iterators and imperfectly-nested loops work together. +// This variant tests loop initialization by declaration. + +typedef __PTRDIFF_TYPE__ ptrdiff_t; +typedef int T; +typedef int S; + +class I +{ +public: + typedef ptrdiff_t difference_type; + I (); + ~I (); + I (T *); + I (const I &); + T &operator * (); + T *operator -> (); + T &operator [] (const difference_type &) const; + I &operator = (const I &); + I &operator ++ (); + I operator ++ (int); + I &operator -- (); + I operator -- (int); + I &operator += (const difference_type &); + I &operator -= (const difference_type &); + I operator + (const difference_type &) const; + I operator - (const difference_type &) const; + friend bool operator == (I &, I &); + friend bool operator == (const I &, const I &); + friend bool operator < (I &, I &); + friend bool operator < (const I &, const I &); + friend bool operator <= (I &, I &); + friend bool operator <= (const I &, const I &); + friend bool operator > (I &, I &); + friend bool operator > (const I &, const I &); + friend bool operator >= (I &, I &); + friend bool operator >= (const I &, const I &); + friend typename I::difference_type operator - (I &, I &); + friend typename I::difference_type operator - (const I &, const I &); + friend I operator + (typename I::difference_type , const I &); +private: + T *p; +}; + I::I () : p (0) {} + I::~I () { p = (T *) 0; } + I::I (T *x) : p (x) {} + I::I (const I &x) : p (x.p) {} + T &I::operator * () { return *p; } + T *I::operator -> () { return p; } + T &I::operator [] (const difference_type &x) const { return p[x]; } + I &I::operator = (const I &x) { p = x.p; return *this; } + I &I::operator ++ () { ++p; return *this; } + I I::operator ++ (int) { return I (p++); } + I &I::operator -- () { --p; return *this; } + I I::operator -- (int) { return I (p--); } + I &I::operator += (const difference_type &x) { p += x; return *this; } + I &I::operator -= (const difference_type &x) { p -= x; return *this; } + I I::operator + (const difference_type &x) const { return I (p + x); } + I I::operator - (const difference_type &x) const { return I (p - x); } + bool operator == (I &x, I &y) { return x.p == y.p; } + bool operator == (const I &x, const I &y) { return x.p == y.p; } + bool operator != (I &x, I &y) { return !(x == y); } + bool operator != (const I &x, const I &y) { return !(x == y); } + bool operator < (I &x, I &y) { return x.p < y.p; } + bool operator < (const I &x, const I &y) { return x.p < y.p; } + bool operator <= (I &x, I &y) { return x.p <= y.p; } + bool operator <= (const I &x, const I &y) { return x.p <= y.p; } + bool operator > (I &x, I &y) { return x.p > y.p; } + bool operator > (const I &x, const I &y) { return x.p > y.p; } + bool operator >= (I &x, I &y) { return x.p >= y.p; } + bool operator >= (const I &x, const I &y) { return x.p >= y.p; } + typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; } + typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; } + I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); } + +class J +{ + public: + J(const I &x, const I &y) : b (x), e (y) {} + const I &begin (); + const I &end (); + private: + I b, e; +}; + +const I &J::begin () { return b; } +const I &J::end () { return e; } + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +void f1 (int depth) +{ + f1count[depth]++; +} + +void f2 (int depth) +{ + f2count[depth]++; +} + +void s1 (J a1, J a2, J a3) +{ +#pragma omp for collapse(3) + for (I i = a1.begin (); i < a1.end (); i++) + { + f1 (0); + for (I j = a2.begin (); j < a2.end (); j++) + { + f1 (1); + for (I k = a3.begin (); k < a3.end (); k++) + { + f1 (2); + f2 (2); + } + f2 (1); + } + f2 (0); + } +} + + +int +main (void) +{ + + int index[] = {0, 1, 2, 3, 4, 5}; + + J x (&index[0], &index[3]); + J y (&index[0], &index[4]); + J z (&index[0], &index[5]); + + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (x, y, z); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-3.C b/libgomp/testsuite/libgomp.c++/imperfect-class-3.C new file mode 100644 index 00000000000..c33826a6b36 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-class-3.C @@ -0,0 +1,167 @@ +// { dg-do run } +// Test that class iterators and imperfectly-nested loops work together. +// This variant tests range for. + +typedef __PTRDIFF_TYPE__ ptrdiff_t; +typedef int T; +typedef int S; + +class I +{ +public: + typedef ptrdiff_t difference_type; + I (); + ~I (); + I (T *); + I (const I &); + T &operator * (); + T *operator -> (); + T &operator [] (const difference_type &) const; + I &operator = (const I &); + I &operator ++ (); + I operator ++ (int); + I &operator -- (); + I operator -- (int); + I &operator += (const difference_type &); + I &operator -= (const difference_type &); + I operator + (const difference_type &) const; + I operator - (const difference_type &) const; + friend bool operator == (I &, I &); + friend bool operator == (const I &, const I &); + friend bool operator < (I &, I &); + friend bool operator < (const I &, const I &); + friend bool operator <= (I &, I &); + friend bool operator <= (const I &, const I &); + friend bool operator > (I &, I &); + friend bool operator > (const I &, const I &); + friend bool operator >= (I &, I &); + friend bool operator >= (const I &, const I &); + friend typename I::difference_type operator - (I &, I &); + friend typename I::difference_type operator - (const I &, const I &); + friend I operator + (typename I::difference_type , const I &); +private: + T *p; +}; + I::I () : p (0) {} + I::~I () { p = (T *) 0; } + I::I (T *x) : p (x) {} + I::I (const I &x) : p (x.p) {} + T &I::operator * () { return *p; } + T *I::operator -> () { return p; } + T &I::operator [] (const difference_type &x) const { return p[x]; } + I &I::operator = (const I &x) { p = x.p; return *this; } + I &I::operator ++ () { ++p; return *this; } + I I::operator ++ (int) { return I (p++); } + I &I::operator -- () { --p; return *this; } + I I::operator -- (int) { return I (p--); } + I &I::operator += (const difference_type &x) { p += x; return *this; } + I &I::operator -= (const difference_type &x) { p -= x; return *this; } + I I::operator + (const difference_type &x) const { return I (p + x); } + I I::operator - (const difference_type &x) const { return I (p - x); } + bool operator == (I &x, I &y) { return x.p == y.p; } + bool operator == (const I &x, const I &y) { return x.p == y.p; } + bool operator != (I &x, I &y) { return !(x == y); } + bool operator != (const I &x, const I &y) { return !(x == y); } + bool operator < (I &x, I &y) { return x.p < y.p; } + bool operator < (const I &x, const I &y) { return x.p < y.p; } + bool operator <= (I &x, I &y) { return x.p <= y.p; } + bool operator <= (const I &x, const I &y) { return x.p <= y.p; } + bool operator > (I &x, I &y) { return x.p > y.p; } + bool operator > (const I &x, const I &y) { return x.p > y.p; } + bool operator >= (I &x, I &y) { return x.p >= y.p; } + bool operator >= (const I &x, const I &y) { return x.p >= y.p; } + typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; } + typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; } + I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); } + +class J +{ + public: + J(const I &x, const I &y) : b (x), e (y) {} + const I &begin (); + const I &end (); + private: + I b, e; +}; + +const I &J::begin () { return b; } +const I &J::end () { return e; } + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +void f1 (int depth) +{ + f1count[depth]++; +} + +void f2 (int depth) +{ + f2count[depth]++; +} + +void s1 (J a1, J a2, J a3) +{ +#pragma omp for collapse(3) + for (auto i : a1) + { + f1 (0); + for (auto j : a2) + { + f1 (1); + for (auto k : a3) + { + f1 (2); + f2 (2); + } + f2 (1); + } + f2 (0); + } +} + + +int +main (void) +{ + + int index[] = {0, 1, 2, 3, 4, 5}; + + J x (&index[0], &index[3]); + J y (&index[0], &index[4]); + J z (&index[0], &index[5]); + + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (x, y, z); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c++/imperfect-destructor.C b/libgomp/testsuite/libgomp.c++/imperfect-destructor.C new file mode 100644 index 00000000000..bd87760e076 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-destructor.C @@ -0,0 +1,135 @@ +/* { dg-do run } */ + +/* Make sure destructors are called for class variables bound + in intervening code. */ + +static int f1count[3], f2count[3]; +static int g1count[3], g2count[3]; + +static int ccount[3], dcount[3]; + +class C { + public: + int n; + C (int nn) { n = nn; ccount[n]++; } + ~C () { dcount[n]++; n = 0; } +}; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +int f1 (int depth, int iter) +{ + f1count[depth]++; + return iter; +} + +int f2 (int depth, int iter) +{ + f2count[depth]++; + return iter; +} + +int g1 (int depth, int iter) +{ + g1count[depth]++; + return iter; +} + +int g2 (int depth, int iter) +{ + g2count[depth]++; + return iter; +} + +void s1 (int a1, int a2, int a3) +{ + int i, j, k; + +#pragma omp for collapse(3) + for (i = 0; i < a1; i++) + { + C local0(0); + f1 (local0.n, i); + { + g1 (local0.n, i); + for (j = 0; j < a2; j++) + { + C local1(1); + f1 (local1.n, j); + { + g1 (local1.n, j); + for (k = 0; k < a3; k++) + { + C local2(2); + f1 (local2.n, k); + { + g1 (local2.n, k); + g2 (local2.n, k); + } + f2 (local2.n, k); + } + g2 (local1.n, j); + } + f2 (local1.n, j); + } + g2 (local0.n, i); + } + f2 (local0.n, i); + } +} + +int +main (void) +{ + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + g1count[0] = 0; + g1count[1] = 0; + g1count[2] = 0; + g2count[0] = 0; + g2count[1] = 0; + g2count[2] = 0; + + s1 (3, 4, 5); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + if (g1count[0] != f1count[0]) abort (); + if (g2count[0] != f1count[0]) abort (); + if (g1count[1] != f1count[1]) abort (); + if (g2count[1] != f1count[1]) abort (); + if (g1count[2] != f1count[2]) abort (); + if (g2count[2] != f1count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); + + /* Check that each class object declared in intervening code was + constructed and destructed an equal number of times. */ + if (ccount[0] != dcount[0]) abort (); + if (ccount[1] != dcount[1]) abort (); + if (ccount[2] != dcount[2]) abort (); +} diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-1.C b/libgomp/testsuite/libgomp.c++/imperfect-template-1.C new file mode 100644 index 00000000000..4ed96c8319b --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-template-1.C @@ -0,0 +1,172 @@ +// { dg-do run } +// Test that template class iterators and imperfectly-nested loops +// work together. +// This variant tests initialization by assignment. + +typedef __PTRDIFF_TYPE__ ptrdiff_t; +extern "C" void abort (); + +template +class I +{ +public: + typedef ptrdiff_t difference_type; + I (); + ~I (); + I (T *); + I (const I &); + T &operator * (); + T *operator -> (); + T &operator [] (const difference_type &) const; + I &operator = (const I &); + I &operator ++ (); + I operator ++ (int); + I &operator -- (); + I operator -- (int); + I &operator += (const difference_type &); + I &operator -= (const difference_type &); + I operator + (const difference_type &) const; + I operator - (const difference_type &) const; + template friend bool operator == (I &, I &); + template friend bool operator == (const I &, const I &); + template friend bool operator < (I &, I &); + template friend bool operator < (const I &, const I &); + template friend bool operator <= (I &, I &); + template friend bool operator <= (const I &, const I &); + template friend bool operator > (I &, I &); + template friend bool operator > (const I &, const I &); + template friend bool operator >= (I &, I &); + template friend bool operator >= (const I &, const I &); + template friend typename I::difference_type operator - (I &, I &); + template friend typename I::difference_type operator - (const I &, const I &); + template friend I operator + (typename I::difference_type , const I &); +private: + T *p; +}; +template I::I () : p (0) {} +template I::~I () { p = (T *) 0; } +template I::I (T *x) : p (x) {} +template I::I (const I &x) : p (x.p) {} +template T &I::operator * () { return *p; } +template T *I::operator -> () { return p; } +template T &I::operator [] (const difference_type &x) const { return p[x]; } +template I &I::operator = (const I &x) { p = x.p; return *this; } +template I &I::operator ++ () { ++p; return *this; } +template I I::operator ++ (int) { return I (p++); } +template I &I::operator -- () { --p; return *this; } +template I I::operator -- (int) { return I (p--); } +template I &I::operator += (const difference_type &x) { p += x; return *this; } +template I &I::operator -= (const difference_type &x) { p -= x; return *this; } +template I I::operator + (const difference_type &x) const { return I (p + x); } +template I I::operator - (const difference_type &x) const { return I (p - x); } +template bool operator == (I &x, I &y) { return x.p == y.p; } +template bool operator == (const I &x, const I &y) { return x.p == y.p; } +template bool operator != (I &x, I &y) { return !(x == y); } +template bool operator != (const I &x, const I &y) { return !(x == y); } +template bool operator < (I &x, I &y) { return x.p < y.p; } +template bool operator < (const I &x, const I &y) { return x.p < y.p; } +template bool operator <= (I &x, I &y) { return x.p <= y.p; } +template bool operator <= (const I &x, const I &y) { return x.p <= y.p; } +template bool operator > (I &x, I &y) { return x.p > y.p; } +template bool operator > (const I &x, const I &y) { return x.p > y.p; } +template bool operator >= (I &x, I &y) { return x.p >= y.p; } +template bool operator >= (const I &x, const I &y) { return x.p >= y.p; } +template typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; } +template typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; } +template I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); } + +template +class J +{ +public: + J(const I &x, const I &y) : b (x), e (y) {} + const I &begin (); + const I &end (); +private: + I b, e; +}; + +template const I &J::begin () { return b; } +template const I &J::end () { return e; } + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +void f1 (int depth) +{ + f1count[depth]++; +} + +void f2 (int depth) +{ + f2count[depth]++; +} + +template +void s1 (J a1, J a2, J a3) +{ + I i, j, k; + +#pragma omp for collapse(3) + for (i = a1.begin (); i < a1.end (); i++) + { + f1 (0); + for (j = a2.begin (); j < a2.end (); j++) + { + f1 (1); + for (k = a3.begin (); k < a3.end (); k++) + { + f1 (2); + f2 (2); + } + f2 (1); + } + f2 (0); + } +} + + +int +main (void) +{ + + int index[] = {0, 1, 2, 3, 4, 5}; + + J x (&index[0], &index[3]); + J y (&index[0], &index[4]); + J z (&index[0], &index[5]); + + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (x, y, z); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-2.C b/libgomp/testsuite/libgomp.c++/imperfect-template-2.C new file mode 100644 index 00000000000..a41c87c481f --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-template-2.C @@ -0,0 +1,170 @@ +// { dg-do run } +// Test that template class iterators and imperfectly-nested loops +// work together. +// This variant tests initialization by declaration. + +typedef __PTRDIFF_TYPE__ ptrdiff_t; +extern "C" void abort (); + +template +class I +{ +public: + typedef ptrdiff_t difference_type; + I (); + ~I (); + I (T *); + I (const I &); + T &operator * (); + T *operator -> (); + T &operator [] (const difference_type &) const; + I &operator = (const I &); + I &operator ++ (); + I operator ++ (int); + I &operator -- (); + I operator -- (int); + I &operator += (const difference_type &); + I &operator -= (const difference_type &); + I operator + (const difference_type &) const; + I operator - (const difference_type &) const; + template friend bool operator == (I &, I &); + template friend bool operator == (const I &, const I &); + template friend bool operator < (I &, I &); + template friend bool operator < (const I &, const I &); + template friend bool operator <= (I &, I &); + template friend bool operator <= (const I &, const I &); + template friend bool operator > (I &, I &); + template friend bool operator > (const I &, const I &); + template friend bool operator >= (I &, I &); + template friend bool operator >= (const I &, const I &); + template friend typename I::difference_type operator - (I &, I &); + template friend typename I::difference_type operator - (const I &, const I &); + template friend I operator + (typename I::difference_type , const I &); +private: + T *p; +}; +template I::I () : p (0) {} +template I::~I () { p = (T *) 0; } +template I::I (T *x) : p (x) {} +template I::I (const I &x) : p (x.p) {} +template T &I::operator * () { return *p; } +template T *I::operator -> () { return p; } +template T &I::operator [] (const difference_type &x) const { return p[x]; } +template I &I::operator = (const I &x) { p = x.p; return *this; } +template I &I::operator ++ () { ++p; return *this; } +template I I::operator ++ (int) { return I (p++); } +template I &I::operator -- () { --p; return *this; } +template I I::operator -- (int) { return I (p--); } +template I &I::operator += (const difference_type &x) { p += x; return *this; } +template I &I::operator -= (const difference_type &x) { p -= x; return *this; } +template I I::operator + (const difference_type &x) const { return I (p + x); } +template I I::operator - (const difference_type &x) const { return I (p - x); } +template bool operator == (I &x, I &y) { return x.p == y.p; } +template bool operator == (const I &x, const I &y) { return x.p == y.p; } +template bool operator != (I &x, I &y) { return !(x == y); } +template bool operator != (const I &x, const I &y) { return !(x == y); } +template bool operator < (I &x, I &y) { return x.p < y.p; } +template bool operator < (const I &x, const I &y) { return x.p < y.p; } +template bool operator <= (I &x, I &y) { return x.p <= y.p; } +template bool operator <= (const I &x, const I &y) { return x.p <= y.p; } +template bool operator > (I &x, I &y) { return x.p > y.p; } +template bool operator > (const I &x, const I &y) { return x.p > y.p; } +template bool operator >= (I &x, I &y) { return x.p >= y.p; } +template bool operator >= (const I &x, const I &y) { return x.p >= y.p; } +template typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; } +template typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; } +template I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); } + +template +class J +{ +public: + J(const I &x, const I &y) : b (x), e (y) {} + const I &begin (); + const I &end (); +private: + I b, e; +}; + +template const I &J::begin () { return b; } +template const I &J::end () { return e; } + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +void f1 (int depth) +{ + f1count[depth]++; +} + +void f2 (int depth) +{ + f2count[depth]++; +} + +template +void s1 (J a1, J a2, J a3) +{ +#pragma omp for collapse(3) + for (I i = a1.begin (); i < a1.end (); i++) + { + f1 (0); + for (I j = a2.begin (); j < a2.end (); j++) + { + f1 (1); + for (I k = a3.begin (); k < a3.end (); k++) + { + f1 (2); + f2 (2); + } + f2 (1); + } + f2 (0); + } +} + + +int +main (void) +{ + + int index[] = {0, 1, 2, 3, 4, 5}; + + J x (&index[0], &index[3]); + J y (&index[0], &index[4]); + J z (&index[0], &index[5]); + + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (x, y, z); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-3.C b/libgomp/testsuite/libgomp.c++/imperfect-template-3.C new file mode 100644 index 00000000000..2e464ed5510 --- /dev/null +++ b/libgomp/testsuite/libgomp.c++/imperfect-template-3.C @@ -0,0 +1,170 @@ +// { dg-do run } +// Test that template class iterators and imperfectly-nested loops +// work together. +// This variant tests range for syntax. + +typedef __PTRDIFF_TYPE__ ptrdiff_t; +extern "C" void abort (); + +template +class I +{ +public: + typedef ptrdiff_t difference_type; + I (); + ~I (); + I (T *); + I (const I &); + T &operator * (); + T *operator -> (); + T &operator [] (const difference_type &) const; + I &operator = (const I &); + I &operator ++ (); + I operator ++ (int); + I &operator -- (); + I operator -- (int); + I &operator += (const difference_type &); + I &operator -= (const difference_type &); + I operator + (const difference_type &) const; + I operator - (const difference_type &) const; + template friend bool operator == (I &, I &); + template friend bool operator == (const I &, const I &); + template friend bool operator < (I &, I &); + template friend bool operator < (const I &, const I &); + template friend bool operator <= (I &, I &); + template friend bool operator <= (const I &, const I &); + template friend bool operator > (I &, I &); + template friend bool operator > (const I &, const I &); + template friend bool operator >= (I &, I &); + template friend bool operator >= (const I &, const I &); + template friend typename I::difference_type operator - (I &, I &); + template friend typename I::difference_type operator - (const I &, const I &); + template friend I operator + (typename I::difference_type , const I &); +private: + T *p; +}; +template I::I () : p (0) {} +template I::~I () { p = (T *) 0; } +template I::I (T *x) : p (x) {} +template I::I (const I &x) : p (x.p) {} +template T &I::operator * () { return *p; } +template T *I::operator -> () { return p; } +template T &I::operator [] (const difference_type &x) const { return p[x]; } +template I &I::operator = (const I &x) { p = x.p; return *this; } +template I &I::operator ++ () { ++p; return *this; } +template I I::operator ++ (int) { return I (p++); } +template I &I::operator -- () { --p; return *this; } +template I I::operator -- (int) { return I (p--); } +template I &I::operator += (const difference_type &x) { p += x; return *this; } +template I &I::operator -= (const difference_type &x) { p -= x; return *this; } +template I I::operator + (const difference_type &x) const { return I (p + x); } +template I I::operator - (const difference_type &x) const { return I (p - x); } +template bool operator == (I &x, I &y) { return x.p == y.p; } +template bool operator == (const I &x, const I &y) { return x.p == y.p; } +template bool operator != (I &x, I &y) { return !(x == y); } +template bool operator != (const I &x, const I &y) { return !(x == y); } +template bool operator < (I &x, I &y) { return x.p < y.p; } +template bool operator < (const I &x, const I &y) { return x.p < y.p; } +template bool operator <= (I &x, I &y) { return x.p <= y.p; } +template bool operator <= (const I &x, const I &y) { return x.p <= y.p; } +template bool operator > (I &x, I &y) { return x.p > y.p; } +template bool operator > (const I &x, const I &y) { return x.p > y.p; } +template bool operator >= (I &x, I &y) { return x.p >= y.p; } +template bool operator >= (const I &x, const I &y) { return x.p >= y.p; } +template typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; } +template typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; } +template I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); } + +template +class J +{ +public: + J(const I &x, const I &y) : b (x), e (y) {} + const I &begin (); + const I &end (); +private: + I b, e; +}; + +template const I &J::begin () { return b; } +template const I &J::end () { return e; } + +static int f1count[3], f2count[3]; + +#ifndef __cplusplus +extern void abort (void); +#else +extern "C" void abort (void); +#endif + +void f1 (int depth) +{ + f1count[depth]++; +} + +void f2 (int depth) +{ + f2count[depth]++; +} + +template +void s1 (J a1, J a2, J a3) +{ +#pragma omp for collapse(3) + for (auto i : a1) + { + f1 (0); + for (auto j : a2) + { + f1 (1); + for (auto k : a3) + { + f1 (2); + f2 (2); + } + f2 (1); + } + f2 (0); + } +} + + +int +main (void) +{ + + int index[] = {0, 1, 2, 3, 4, 5}; + + J x (&index[0], &index[3]); + J y (&index[0], &index[4]); + J z (&index[0], &index[5]); + + f1count[0] = 0; + f1count[1] = 0; + f1count[2] = 0; + f2count[0] = 0; + f2count[1] = 0; + f2count[2] = 0; + + s1 (x, y, z); + + /* All intervening code at the same depth must be executed the same + number of times. */ + if (f1count[0] != f2count[0]) abort (); + if (f1count[1] != f2count[1]) abort (); + if (f1count[2] != f2count[2]) abort (); + + /* Intervening code must be executed at least as many times as the loop + that encloses it. */ + if (f1count[0] < 3) abort (); + if (f1count[1] < 3 * 4) abort (); + + /* Intervening code must not be executed more times than the number + of logical iterations. */ + if (f1count[0] > 3 * 4 * 5) abort (); + if (f1count[1] > 3 * 4 * 5) abort (); + + /* Check that the innermost loop body is executed exactly the number + of logical iterations expected. */ + if (f1count[2] != 3 * 4 * 5) abort (); +} From patchwork Fri Apr 28 23:22:54 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 1775177 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4Q7TFk3Qxvz23tZ for ; Sat, 29 Apr 2023 09:24:10 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 77DFB3853566 for ; Fri, 28 Apr 2023 23:24:08 +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 DD80A385828D for ; Fri, 28 Apr 2023 23:23:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org DD80A385828D Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.99,235,1677571200"; d="scan'208";a="3821650" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 28 Apr 2023 15:23:18 -0800 IronPort-SDR: /2g9qORgPq78r0bxqoO5buNiEMVhzYfAwVy48x1rT+oh4Bdbs0tZYsKQ1svWnfON+P7J/EL/ne 6AlnXuTxleiMfj5n4GA0kOkjDb7JdUAhIfS5WaAE/So4EDQ+9zyyZZ/pPfEUNFjADrO0F48rtD WcrEWklzziegSRs7w6hRuDxzI+tuZJzZnjP88S6GsGKhHpQfIV+7BtIXWcOqAZOYnLnCD9shlm vnIOVI4W3nhOiquZR82TXiURWJkLmlvUWRYTProuSxfZejxLZufk+kbyBdoVykEYo6bboEs+nH IjM= From: Sandra Loosemore To: Subject: [PATCH 3/3] OpenMP: Fortran support for imperfectly-nested loops Date: Fri, 28 Apr 2023 17:22:54 -0600 Message-ID: <20230428232254.628185-4-sandra@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20230428232254.628185-1-sandra@codesourcery.com> References: <20230428232254.628185-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-12.mgc.mentorg.com (147.34.90.212) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-9.4 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, T_FILL_THIS_FORM_SHORT, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" OpenMP 5.0 removed the restriction that multiple collapsed loops must be perfectly nested, allowing "intervening code" (including nested BLOCKs) before or after each nested loop. In GCC this code is moved into the inner loop body by the respective front ends. In the Fortran front end, most of the semantic processing happens during the translation phase, so the parse phase just collects the intervening statements, checks them for errors, and splices them around the loop body. gcc/fortran/ChangeLog * openmp.cc: Include omp-api.h. (resolve_omp_clauses): Consolidate inscan reduction clause conflict checking here. (find_nested_loop_in_chain): New. (find_nested_loop_in_block): New. (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse properly. Handle imperfectly-nested loops when looking for nested omp scan. Refactor to move inscan reduction clause conflict checking to resolve_omp_clauses. (gfc_resolve_do_iterator): Handle imperfectly-nested loops. (struct icode_error_state): New. (icode_code_error_callback): New. (icode_expr_error_callback): New. (diagnose_intervening_code_errors_1): New. (diagnose_intervening_code_errors): New. (restructure_intervening_code): New. (is_outer_iteration_variable): Do not assume loops are perfectly nested. (expr_is_invariant): Likewise. (resolve_omp_do): Handle imperfectly-nested loops. gcc/testsuite/ChangeLog * gfortran.dg/gomp/collapse1.f90: Adjust expected errors. * gfortran.dg/gomp/collapse2.f90: Likewise. * gfortran.dg/gomp/imperfect1.f90: New. * gfortran.dg/gomp/imperfect2.f90: New. * gfortran.dg/gomp/imperfect3.f90: New. * gfortran.dg/gomp/imperfect4.f90: New. * gfortran.dg/gomp/imperfect5.f90: New. libgomp/ChangeLog * testsuite/libgomp.fortran/imperfect-destructor.f90: New. * testsuite/libgomp.fortran/imperfect1.f90: New. * testsuite/libgomp.fortran/imperfect2.f90: New. * testsuite/libgomp.fortran/imperfect3.f90: New. * testsuite/libgomp.fortran/imperfect4.f90: New. * testsuite/libgomp.fortran/offload-imperfect1.f90: New. * testsuite/libgomp.fortran/offload-imperfect2.f90: New. * testsuite/libgomp.fortran/offload-imperfect3.f90: New. * testsuite/libgomp.fortran/offload-imperfect4.f90: New. --- gcc/fortran/openmp.cc | 590 +++++++++++++++--- gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 6 +- gcc/testsuite/gfortran.dg/gomp/collapse2.f90 | 10 +- gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 | 39 ++ gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 | 56 ++ gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 | 29 + gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 | 36 ++ gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 | 67 ++ .../libgomp.fortran/imperfect-destructor.f90 | 142 +++++ .../testsuite/libgomp.fortran/imperfect1.f90 | 67 ++ .../testsuite/libgomp.fortran/imperfect2.f90 | 102 +++ .../testsuite/libgomp.fortran/imperfect3.f90 | 110 ++++ .../testsuite/libgomp.fortran/imperfect4.f90 | 121 ++++ .../libgomp.fortran/offload-imperfect1.f90 | 72 +++ .../libgomp.fortran/offload-imperfect2.f90 | 110 ++++ .../libgomp.fortran/offload-imperfect3.f90 | 116 ++++ .../libgomp.fortran/offload-imperfect4.f90 | 126 ++++ 17 files changed, 1697 insertions(+), 102 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect4.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90 diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 86e451531a6..25c4c07138d 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -30,6 +30,7 @@ along with GCC; see the file COPYING3. If not see #include "gomp-constants.h" #include "target-memory.h" /* For gfc_encode_character. */ #include "bitmap.h" +#include "omp-api.h" /* For omp_runtime_api_procname. */ static gfc_statement omp_code_to_statement (gfc_code *); @@ -7209,15 +7210,24 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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); + if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + locus *loc = &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where; + if (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", + loc); + if (omp_clauses->ordered) + gfc_error ("ORDERED clause specified together with % " + "REDUCTION clause at %L", loc); + if (omp_clauses->sched_kind != OMP_SCHED_NONE) + gfc_error ("SCHEDULE clause specified together with % " + "REDUCTION clause at %L", loc); + } for (list = 0; list < OMP_LIST_NUM; list++) if (list != OMP_LIST_FIRSTPRIVATE @@ -9033,68 +9043,114 @@ static struct fortran_omp_context static gfc_code *omp_current_do_code; static int omp_current_do_collapse; +/* Forward declaration for mutually recursive functions. */ +static gfc_code * +find_nested_loop_in_block (gfc_code *block); + +/* Return the first nested DO loop in CHAIN, or NULL if there + isn't one. Does no error checking on intervening code. */ + +static gfc_code * +find_nested_loop_in_chain (gfc_code *chain) +{ + gfc_code *code; + + if (!chain) + return NULL; + + for (code = chain; code; code = code->next) + { + if (code->op == EXEC_DO) + return code; + else if (code->op == EXEC_BLOCK) + { + gfc_code *c = find_nested_loop_in_block (code); + if (c) + return c; + } + } + return NULL; +} + +/* Return the first nested DO loop in BLOCK, or NULL if there + isn't one. Does no error checking on intervening code. */ +static gfc_code * +find_nested_loop_in_block (gfc_code *block) +{ + gfc_namespace *ns; + gcc_assert (block->op == EXEC_BLOCK); + ns = block->ext.block.ns; + gcc_assert (ns); + return find_nested_loop_in_chain (ns->code); +} + void gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) { if (code->block->next && code->block->next->op == EXEC_DO) { int i; - gfc_code *c; omp_current_do_code = code->block->next; if (code->ext.omp_clauses->orderedc) omp_current_do_collapse = code->ext.omp_clauses->orderedc; - else + else if (code->ext.omp_clauses->collapse) omp_current_do_collapse = code->ext.omp_clauses->collapse; - for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++) - { - c = c->block; - if (c->op != EXEC_DO || c->next == NULL) - break; - c = c->next; - if (c->op != EXEC_DO) - break; - } - if (i < omp_current_do_collapse || omp_current_do_collapse <= 0) + else omp_current_do_collapse = 1; if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) { + /* Checking that there is a matching EXEC_OMP_SCAN in the + innermost body cannot be deferred to resolve_omp_do because + we process directives nested in the loop before we get + there. */ locus *loc = &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where; - if (code->ext.omp_clauses->ordered) - gfc_error ("ORDERED clause specified together with % " - "REDUCTION clause at %L", loc); - if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE) - gfc_error ("SCHEDULE clause specified together with % " - "REDUCTION clause at %L", loc); - gfc_code *block = c->block ? c->block->next : NULL; - if (block && block->op != EXEC_OMP_SCAN) - while (block && block->next && block->next->op != EXEC_OMP_SCAN) - block = block->next; - if (!block - || (block->op != EXEC_OMP_SCAN - && (!block->next || block->next->op != EXEC_OMP_SCAN))) - gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN " - "between two structured block sequences", loc); - else + gfc_code *c; + + for (i = 1, c = omp_current_do_code; + i < omp_current_do_collapse; i++) { - if (block->op == EXEC_OMP_SCAN) - gfc_warning (0, "!$OMP SCAN at %L with zero executable " - "statements in preceding structured block " - "sequence", &block->loc); - if ((block->op == EXEC_OMP_SCAN && !block->next) - || (block->next && block->next->op == EXEC_OMP_SCAN - && !block->next->next)) - gfc_warning (0, "!$OMP SCAN at %L with zero executable " - "statements in succeeding structured block " - "sequence", block->op == EXEC_OMP_SCAN - ? &block->loc : &block->next->loc); - } - if (block && block->op != EXEC_OMP_SCAN) - block = block->next; - if (block && block->op == EXEC_OMP_SCAN) - /* Mark 'omp scan' as checked; flag will be unset later. */ - block->ext.omp_clauses->if_present = true; + c = find_nested_loop_in_chain (c->block->next); + if (!c || c->op != EXEC_DO || c->block == NULL) + break; + } + + /* Skip this if we don't have enough nested loops. That + problem will be diagnosed elsewhere. */ + if (c && c->op == EXEC_DO) + { + gfc_code *block = c->block ? c->block->next : NULL; + if (block && block->op != EXEC_OMP_SCAN) + while (block && block->next + && block->next->op != EXEC_OMP_SCAN) + block = block->next; + if (!block + || (block->op != EXEC_OMP_SCAN + && (!block->next || block->next->op != EXEC_OMP_SCAN))) + gfc_error ("With INSCAN at %L, expected loop body with " + "!$OMP SCAN between two " + "structured block sequences", loc); + else + { + if (block->op == EXEC_OMP_SCAN) + gfc_warning (0, "!$OMP SCAN at %L with zero executable " + "statements in preceding structured block " + "sequence", &block->loc); + if ((block->op == EXEC_OMP_SCAN && !block->next) + || (block->next && block->next->op == EXEC_OMP_SCAN + && !block->next->next)) + gfc_warning (0, "!$OMP SCAN at %L with zero executable " + "statements in succeeding structured block " + "sequence", block->op == EXEC_OMP_SCAN + ? &block->loc : &block->next->loc); + } + if (block && block->op != EXEC_OMP_SCAN) + block = block->next; + if (block && block->op == EXEC_OMP_SCAN) + /* Mark 'omp scan' as checked; flag will be unset later. */ + block->ext.omp_clauses->if_present = true; + } } } gfc_resolve_blocks (code->block, ns); @@ -9224,13 +9280,12 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause) private just in the !$omp do resp. !$omp parallel do construct, with no implications for the outer parallel constructs. */ - while (i-- >= 1) + while (i-- >= 1 && c) { if (code == c) return; - - c = c->block->next; - } + c = find_nested_loop_in_chain (c->block->next); + } /* An openacc context may represent a data clause. Abort if so. */ if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code)) @@ -9269,20 +9324,332 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns) gfc_traverse_ns (ns, handle_local_var); } + +/* Error checking on intervening code uses a code walker. */ + +struct icode_error_state +{ + const char *name; + bool errorp; + gfc_code *nested; + gfc_code *next; +}; + +static int +icode_code_error_callback (gfc_code **codep, + int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque) +{ + gfc_code *code = *codep; + icode_error_state *state = (icode_error_state *)opaque; + + /* gfc_code_walker walks down CODE's next chain as well as + walking things that are actually nested in CODE. We need to + special-case traversal of outer blocks, so stop immediately if we + are heading down such a next chain. */ + if (code == state->next) + return 1; + + switch (code->op) + { + case EXEC_DO: + case EXEC_DO_WHILE: + case EXEC_DO_CONCURRENT: + gfc_error ("%s cannot contain loop in intervening code at %L", + state->name, &code->loc); + state->errorp = true; + break; + case EXEC_CYCLE: + case EXEC_EXIT: + /* Errors have already been diagnosed in match_exit_cycle. */ + state->errorp = true; + break; + case EXEC_OMP_CRITICAL: + case EXEC_OMP_DO: + case EXEC_OMP_FLUSH: + case EXEC_OMP_MASTER: + case EXEC_OMP_ORDERED: + case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SECTIONS: + case EXEC_OMP_SINGLE: + case EXEC_OMP_WORKSHARE: + case EXEC_OMP_ATOMIC: + case EXEC_OMP_BARRIER: + case EXEC_OMP_END_NOWAIT: + case EXEC_OMP_END_SINGLE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKWAIT: + case EXEC_OMP_TASKYIELD: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_TASKGROUP: + case EXEC_OMP_SIMD: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TEAMS: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_SIMD: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_UPDATE: + case EXEC_OMP_END_CRITICAL: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_SCAN: + case EXEC_OMP_DEPOBJ: + case EXEC_OMP_PARALLEL_MASTER: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASTER_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_LOOP: + case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_TEAMS_LOOP: + case EXEC_OMP_TARGET_PARALLEL_LOOP: + case EXEC_OMP_TARGET_TEAMS_LOOP: + case EXEC_OMP_MASKED: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_SCOPE: + case EXEC_OMP_ERROR: + gfc_error ("%s cannot contain OMP directive in intervening code " + "at %L", + state->name, &code->loc); + state->errorp = true; + break; + case EXEC_CALL: + /* Per OpenMP 5.2, the "omp_" prefix is reserved, so we don't have to + consider the possibility that some locally-bound definition + overrides the runtime routine. */ + if (code->resolved_sym + && omp_runtime_api_procname (code->resolved_sym->name)) + { + gfc_error ("%s cannot contain OMP API call in intervening code " + "at %L", + state->name, &code->loc); + state->errorp = true; + } + break; + default: + break; + } + return 0; +} + +static int +icode_expr_error_callback (gfc_expr **expr, + int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque) +{ + icode_error_state *state = (icode_error_state *)opaque; + + switch ((*expr)->expr_type) + { + /* As for EXPR_CALL with "omp_"-prefixed symbols. */ + case EXPR_FUNCTION: + { + gfc_symbol *sym = (*expr)->value.function.esym; + if (sym && omp_runtime_api_procname (sym->name)) + { + gfc_error ("%s cannot contain OMP API call in intervening code " + "at %L", + state->name, &((*expr)->where)); + state->errorp = true; + } + } + + break; + default: + break; + } + + /* FIXME: The description of canonical loop form in the OpenMP standard + also says "array expressions" are not permitted in intervening code. + That term is not defined in either the OpenMP spec or the Fortran + standard, although the latter uses it informally to refer to any + expression that is not scalar-valued. It is also apparently not the + thing GCC internally calls EXPR_ARRAY. It seems the intent of the + OpenMP restriction is to disallow elemental operations/intrinsics + (including things that are not expressions, like assignment + statements) that generate implicit loops over array operands + (even if the result is a scalar), but even if the spec said + that there is no list of all the cases that would be forbidden. + This is OpenMP issue 3326. */ + + return 0; +} + +static void +diagnose_intervening_code_errors_1 (gfc_code *chain, + struct icode_error_state *state) +{ + gfc_code *code; + for (code = chain; code; code = code->next) + { + if (code == state->nested) + /* Do not walk the nested loop or its body, we are only + interested in intervening code. */ + ; + else if (code->op == EXEC_BLOCK + && find_nested_loop_in_block (code) == state->nested) + /* This block contains the nested loop, recurse on its + statements. */ + { + gfc_namespace* ns = code->ext.block.ns; + diagnose_intervening_code_errors_1 (ns->code, state); + } + else + /* Treat the whole statement as a unit. */ + { + gfc_code *temp = state->next; + state->next = code->next; + gfc_code_walker (&code, icode_code_error_callback, + icode_expr_error_callback, state); + state->next = temp; + } + } +} + +/* Diagnose intervening code errors in BLOCK with nested loop NESTED. + NAME is the user-friendly name of the OMP directive, used for error + messages. Returns true if any error was found. */ +static bool +diagnose_intervening_code_errors (gfc_code *chain, const char *name, + gfc_code *nested) +{ + struct icode_error_state state; + state.name = name; + state.errorp = false; + state.nested = nested; + state.next = NULL; + diagnose_intervening_code_errors_1 (chain, &state); + return state.errorp; +} + +/* Push intervening code surrounding a loop, including nested scopes, + into the body of the loop. CHAINP is the pointer to the head of + the next-chain to scan, OUTER_LOOP is the EXEC_DO for the next outer + loop level, and COLLAPSE is the number of nested loops we need to + process. + Note that CHAINP may point at outer_loop->block->next when we + are scanning the body of a loop, but if there is an intervening block + CHAINP points into the block's chain rather than its enclosing outer + loop. This is why OUTER_LOOP is passed separately. */ +static gfc_code * +restructure_intervening_code (gfc_code **chainp, gfc_code *outer_loop, + int collapse) +{ + gfc_code *code; + gfc_code *head = *chainp; + gfc_code *tail = NULL; + gfc_code *innermost_loop = NULL; + + for (code = *chainp; code; code = code->next, chainp = &((*chainp)->next)) + { + if (code->op == EXEC_DO) + { + /* Cut CODE free from its chain, leaving the ends dangling. */ + *chainp = NULL; + tail = code->next; + code->next = NULL; + + if (collapse == 1) + innermost_loop = code; + else + innermost_loop + = restructure_intervening_code (&(code->block->next), + code, collapse - 1); + break; + } + else if (code->op == EXEC_BLOCK + && find_nested_loop_in_block (code)) + { + gfc_namespace *ns = code->ext.block.ns; + + /* Cut CODE free from its chain, leaving the ends dangling. */ + *chainp = NULL; + tail = code->next; + code->next = NULL; + + innermost_loop + = restructure_intervening_code (&(ns->code), outer_loop, + collapse); + + /* At this point we have already pulled out the nested loop and + pointed outer_loop at it, and moved the intervening code that + was previously in the block into the body of innermost_loop. + Now we want to move the BLOCK itself so it wraps the entire + current body of innermost_loop. */ + ns->code = innermost_loop->block->next; + innermost_loop->block->next = code; + break; + } + } + + gcc_assert (innermost_loop); + + /* Now we have split the intervening code into two parts: + head is the start of the part before the loop/block, terminating + at *chainp, and tail is the part after it. Splice the two parts + around the existing body of the innermost loop. */ + if (head != code) + { + if (innermost_loop->block->next) + gfc_append_code (head, innermost_loop->block->next); + innermost_loop->block->next = head; + } + if (tail) + { + if (innermost_loop->block->next) + gfc_append_code (innermost_loop->block->next, tail); + else + innermost_loop->block->next = tail; + } + + /* For loops, finally splice CODE into OUTER_LOOP. We already handled + relinking EXEC_BLOCK above. */ + if (code->op == EXEC_DO && outer_loop) + outer_loop->block->next = code; + + return innermost_loop; +} + /* CODE is an OMP loop construct. Return true if VAR matches an iteration variable outer to level DEPTH. */ static bool is_outer_iteration_variable (gfc_code *code, int depth, gfc_symbol *var) { int i; - gfc_code *do_code = code->block->next; + gfc_code *do_code = code; for (i = 1; i < depth; i++) { + do_code = find_nested_loop_in_chain (do_code->block->next); + gcc_assert (do_code); gfc_symbol *ivar = do_code->ext.iterator->var->symtree->n.sym; if (var == ivar) return true; - do_code = do_code->block->next; } return false; } @@ -9293,14 +9660,15 @@ static bool expr_is_invariant (gfc_code *code, int depth, gfc_expr *expr) { int i; - gfc_code *do_code = code->block->next; + gfc_code *do_code = code; for (i = 1; i < depth; i++) { + do_code = find_nested_loop_in_chain (do_code->block->next); + gcc_assert (do_code); gfc_symbol *ivar = do_code->ext.iterator->var->symtree->n.sym; if (gfc_find_sym_in_expr (ivar, expr)) return false; - do_code = do_code->block->next; } return true; } @@ -9371,12 +9739,14 @@ bound_expr_is_canonical (gfc_code *code, int depth, gfc_expr *expr, static void resolve_omp_do (gfc_code *code) { - gfc_code *do_code, *c; + gfc_code *do_code, *next; int list, i, collapse; gfc_omp_namelist *n; gfc_symbol *dovar; const char *name; bool is_simd = false; + bool errorp = false; + bool perfect_nesting_errorp = false; switch (code->op) { @@ -9495,26 +9865,33 @@ resolve_omp_do (gfc_code *code) for (i = 1; i <= collapse; i++) { gfc_symbol *start_var = NULL, *end_var = NULL; + /* Parse errors are not recoverable. */ if (do_code->op == EXEC_DO_WHILE) { gfc_error ("%s cannot be a DO WHILE or DO without loop control " "at %L", name, &do_code->loc); - break; + return; } if (do_code->op == EXEC_DO_CONCURRENT) { gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name, &do_code->loc); - break; + return; } gcc_assert (do_code->op == EXEC_DO); if (do_code->ext.iterator->var->ts.type != BT_INTEGER) - gfc_error ("%s iteration variable must be of type integer at %L", - name, &do_code->loc); + { + gfc_error ("%s iteration variable must be of type integer at %L", + name, &do_code->loc); + errorp = true; + } dovar = do_code->ext.iterator->var->symtree->n.sym; if (dovar->attr.threadprivate) - gfc_error ("%s iteration variable must not be THREADPRIVATE " - "at %L", name, &do_code->loc); + { + gfc_error ("%s iteration variable must not be THREADPRIVATE " + "at %L", name, &do_code->loc); + errorp = true; + } if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) if (!is_simd || code->ext.omp_clauses->collapse > 1 @@ -9533,13 +9910,13 @@ resolve_omp_do (gfc_code *code) gfc_error ("%s iteration variable present on clause " "other than PRIVATE, LASTPRIVATE, ALLOCATE or " "LINEAR at %L", name, &do_code->loc); - break; + errorp = true; } if (is_outer_iteration_variable (code, i, dovar)) { gfc_error ("%s iteration variable used in more than one loop at %L", name, &do_code->loc); - break; + errorp = true; } else if (!bound_expr_is_canonical (code, i, do_code->ext.iterator->start, @@ -9547,7 +9924,7 @@ resolve_omp_do (gfc_code *code) { gfc_error ("%s loop start expression not in canonical form at %L", name, &do_code->loc); - break; + errorp = true; } else if (!bound_expr_is_canonical (code, i, do_code->ext.iterator->end, @@ -9555,48 +9932,73 @@ resolve_omp_do (gfc_code *code) { gfc_error ("%s loop end expression not in canonical form at %L", name, &do_code->loc); - break; + errorp = true; } else if (start_var && end_var && start_var != end_var) { gfc_error ("%s loop bounds reference different " "iteration variables at %L", name, &do_code->loc); - break; + errorp = true; } else if (!expr_is_invariant (code, i, do_code->ext.iterator->step)) { gfc_error ("%s loop increment not in canonical form at %L", name, &do_code->loc); - break; + errorp = true; } if (start_var || end_var) code->ext.omp_clauses->non_rectangular = 1; - for (c = do_code->next; c; c = c->next) - if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) - { - gfc_error ("collapsed %s loops not perfectly nested at %L", - name, &c->loc); - break; - } - if (i == collapse || c) + /* Only parse loop body into nested loop and intervening code if + there are supposed to be more loops in the nest to collapse. */ + if (i == collapse) break; - do_code = do_code->block; - if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) + + next = find_nested_loop_in_chain (do_code->block->next); + + if (!next) { - gfc_error ("not enough DO loops for collapsed %s at %L", - name, &code->loc); - break; + /* Parse error, can't recover from this. */ + gfc_error ("not enough DO loops for collapsed %s (level %d) at %L", + name, i, &code->loc); + return; } - do_code = do_code->next; - if (do_code == NULL - || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) + else if (next != do_code->block->next || next->next) + /* Imperfectly nested loop found. */ { - gfc_error ("not enough DO loops for collapsed %s at %L", - name, &code->loc); - break; + /* Only diagnose violation of imperfect nesting constraints once. */ + if (!perfect_nesting_errorp) + { + if (code->ext.omp_clauses->orderedc) + { + gfc_error ("%s inner loops must be perfectly nested with " + "ORDERED clause at %L", + name, &code->loc); + perfect_nesting_errorp = true; + } + else if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + gfc_error ("%s inner loops must be perfectly nested with " + "REDUCTION INSCAN clause at %L", + name, &code->loc); + perfect_nesting_errorp = true; + } + /* FIXME: Also diagnose for TILE directives. */ + if (perfect_nesting_errorp) + errorp = true; + } + if (diagnose_intervening_code_errors (do_code->block->next, + name, next)) + errorp = true; } + do_code = next; } + + /* Give up now if we found any constraint violations. */ + if (errorp) + return; + + restructure_intervening_code (&(code->block->next), code, collapse); } diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index 77b2bdd7fcb..613f06f6ea9 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -31,11 +31,11 @@ subroutine collapse1 do i = 1, 3 do j = 4, 6 end do - k = 4 ! { dg-error "loops not perfectly nested" } + k = 4 end do - !$omp parallel do collapse(2) + !$omp parallel do collapse(2) ! { dg-error "not enough DO loops" } do i = 1, 3 - do ! { dg-error "cannot be a DO WHILE or DO without loop control" } + do end do end do !$omp parallel do collapse(2) diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 index 1ab934e3d0d..9af3b656829 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 @@ -6,24 +6,24 @@ program p do j = 1, 8 do k = 1, 8 end do - x = 5 ! { dg-error "loops not perfectly nested" } + x = 5 end do end do - !$omp parallel do ordered(3) + !$omp parallel do ordered(3) ! { dg-error "inner loops must be perfectly nested" } do i = 1, 8 do j = 1, 8 do k = 1, 8 end do end do - x = 5 ! { dg-error "loops not perfectly nested" } + x = 5 end do - !$omp parallel do collapse(2) ! { dg-error "not enough DO loops for collapsed" } + !$omp parallel do collapse(2) do i = 1, 8 x = 5 do j = 1, 8 end do end do - !$omp parallel do ordered(2) ! { dg-error "not enough DO loops for collapsed" } + !$omp parallel do ordered(2) ! { dg-error "inner loops must be perfectly nested" } do i = 1, 8 x = 5 do j = 1, 8 diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 new file mode 100644 index 00000000000..a718e2711dc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 @@ -0,0 +1,39 @@ +! This test case is expected to fail due to errors. + +subroutine f1 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(3) + do i = 1, a1 + call f1 (1, i) + do j = 1, a2 + call f1 (2, j) + if (i == 3) then + cycle ! { dg-error "CYCLE statement" } + else + exit ! { dg-error "EXIT statement" } + endif +!$omp barrier ! { dg-error "OMP directive in intervening code" } + do k = 1, a3 + call f1 (3, k) + call f2 (3, k) + end do + call f2 (2, j) + end do + do k = 1, a3 ! { dg-error "loop in intervening code" } + call f1 (3, k) + call f2 (3, k) + end do + call f2 (1, i) + end do + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 new file mode 100644 index 00000000000..b741b05f2f4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 @@ -0,0 +1,56 @@ +! This test case is expected to fail due to errors. + +! Note that the calls to these functions in the test case don't make +! any sense in terms of behavior, they're just there to test the error +! behavior. + +module omp_lib + use iso_c_binding + interface + integer function omp_get_thread_num () + end + subroutine omp_set_max_levels (i) + integer :: i + end + end interface +end module + +program junk + use omp_lib + implicit none + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + integer :: m + + !$omp do collapse(3) + do i = 1, a1 + call f1 (1, i) + m = omp_get_thread_num () ! { dg-error "OMP API call in intervening code" } + do j = 1, a2 + omp_get_thread_num () ! This is OK + call f1 (2, j) + do k = 1, a3 + call f1 (m, k) + call omp_set_max_active_levels (k) ! This is OK too + call f2 (m, k) + end do + call f2 (2, j) + call omp_set_max_active_levels (i) ! { dg-error "OMP API call in intervening code" } + end do + call f2 (1, i) + end do +end subroutine + +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 new file mode 100644 index 00000000000..2eccdfc8b58 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 @@ -0,0 +1,29 @@ +! This test case is expected to fail due to errors. + +subroutine f1 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do ordered(3) ! { dg-error "inner loops must be perfectly nested" } + do i = 1, a1 + call f1 (1, i) + do j = 1, a2 + call f1 (2, j) + do k = 1, a3 + call f1 (3, k) + call f2 (3, k) + end do + call f2 (2, j) + end do + call f2 (1, i) + end do + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 new file mode 100644 index 00000000000..b7ccd8b6c53 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 @@ -0,0 +1,36 @@ +! This test case is expected to fail due to errors. + +subroutine f1 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter +end subroutine + +! Unlike the C/C++ front ends, the Fortran front end already has the whole +! parse tree for the OMP DO construct before doing error checking on it. +! It gives up immediately if there are not enough nested loops for the +! specified COLLAPSE depth, without error-checking intervening code. + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(4) ! { dg-error "not enough DO loops" } + do i = 1, a1 + call f1 (1, i) + do j = 1, a2 + call f1 (2, j) + do k = 1, a3 +! This is not valid intervening code, but the above error takes precedence. +!$omp barrier + call f1 (3, k) + call f2 (3, k) + end do + call f2 (2, j) + end do + call f2 (1, i) + end do + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 new file mode 100644 index 00000000000..95cc7f144a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 @@ -0,0 +1,67 @@ +! This test case is expected to fail due to errors. + +subroutine f1 (depth, iter) + integer :: depth, iter +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter +end subroutine + +function ijk (x, y, z) + integer :: ijk + integer :: x, y, z +end function + +subroutine f3 (sum) + integer :: sum +end subroutine + +! This function isn't particularly meaningful, but it should compile without +! error. +function s1 (a1, a2, a3) + integer :: s1 + integer :: a1, a2, a3 + integer :: i, j, k + integer :: r + + r = 0 + !$omp simd collapse(3) reduction (inscan, +:r) + do i = 1, a1 + do j = 1, a2 + do k = 1, a3 + r = r + ijk (i, j, k) +!$omp scan exclusive (r) + call f3 (r) + end do + end do + end do + + s1 = r +end function + +! Adding intervening code should trigger an error. +function s2 (a1, a2, a3) + integer :: s2 + integer :: a1, a2, a3 + integer :: i, j, k + integer :: r + + r = 0 + !$omp simd collapse(3) reduction (inscan, +:r) ! { dg-error "inner loops must be perfectly nested" } + do i = 1, a1 + call f1 (1, i) + do j = 1, a2 + call f1 (2, j) + do k = 1, a3 + r = r + ijk (i, j, k) +!$omp scan exclusive (r) + call f3 (r) + end do + call f2 (2, j) + end do + call f2 (1, i) + end do + + s2 = r +end function diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 new file mode 100644 index 00000000000..664d27fe968 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 @@ -0,0 +1,142 @@ +! { dg-do run } + +! Like imperfect2.f90, but adds bindings to the blocks. + +module m + implicit none + type t + integer :: i + contains + final :: fini + end type t + + integer :: ccount(3), dcount(3) + + contains + + subroutine init(x, n) + type(t) :: x + integer :: n + x%i = n + ccount(x%i) = ccount(x%i) + 1 + end subroutine init + + subroutine fini(x) + type(t) :: x + dcount(x%i) = dcount(x%i) + 1 + end subroutine fini +end module m + +program foo + use m + + integer :: f1count(3), f2count(3), g1count(3), g2count(3) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + + ! Check that constructors and destructors are called equal number of times. + if (ccount(1) /= dcount(1)) error stop 141 + if (ccount(2) /= dcount(2)) error stop 142 + if (ccount(3) /= dcount(3)) error stop 143 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(3) + do i = 1, a1 + call f1 (1, i) + block + type (t) :: local1 + call init (local1, 1) + call g1 (local1%i, i) + do j = 1, a2 + call f1 (2, j) + block + type (t) :: local2 + call init (local2, 2) + call g1 (local2%i, j) + do k = 1, a3 + call f1 (3, k) + block + type (t) :: local3 + call init (local3, 3) + call g1 (local3%i, k) + call g2 (local3%i, k) + end block + call f2 (3, k) + end do + call g2 (local2%i, j) + end block + call f2 (2, j) + end do + call g2 (local1%i, i) + end block + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect1.f90 new file mode 100644 index 00000000000..8c483c2a4e5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect1.f90 @@ -0,0 +1,67 @@ +! { dg-do run } + +program foo + integer, save :: f1count(3), f2count(3) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(3) + do i = 1, a1 + call f1 (1, i) + do j = 1, a2 + call f1 (2, j) + do k = 1, a3 + call f1 (3, k) + call f2 (3, k) + end do + call f2 (2, j) + end do + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect2.f90 new file mode 100644 index 00000000000..e42cb08031b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect2.f90 @@ -0,0 +1,102 @@ +! { dg-do run } + +program foo + integer, save :: f1count(3), f2count(3), g1count(3), g2count(3) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(3) + do i = 1, a1 + call f1 (1, i) + block + call g1 (1, i) + do j = 1, a2 + call f1 (2, j) + block + call g1 (2, j) + do k = 1, a3 + call f1 (3, k) + block + call g1 (3, k) + call g2 (3, k) + end block + call f2 (3, k) + end do + call g2 (2, j) + end block + call f2 (2, j) + end do + call g2 (1, i) + end block + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/imperfect3.f90 new file mode 100644 index 00000000000..da094612332 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect3.f90 @@ -0,0 +1,110 @@ +! { dg-do run } + +! Like imperfect2.f90, but adds bindings to the blocks. + +program foo + integer, save :: f1count(3), f2count(3), g1count(3), g2count(3) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(3) + do i = 1, a1 + call f1 (1, i) + block + integer :: local1 + local1 = 1 + call g1 (local1, i) + do j = 1, a2 + call f1 (2, j) + block + integer :: local2 + local2 = 2 + call g1 (local2, j) + do k = 1, a3 + call f1 (3, k) + block + integer :: local3 + local3 = 3 + call g1 (local3, k) + call g2 (local3, k) + end block + call f2 (3, k) + end do + call g2 (local2, j) + end block + call f2 (2, j) + end do + call g2 (local1, i) + end block + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/imperfect4.f90 new file mode 100644 index 00000000000..1679c8c5b92 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect4.f90 @@ -0,0 +1,121 @@ +! { dg-do run } + +! Like imperfect2.f90, but includes blocks that are themselves wholly +! intervening code and not containers for nested loops. + +program foo + integer, save :: f1count(3), f2count(3), g1count(3), g2count(3) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp do collapse(3) + do i = 1, a1 + block + call f1 (1, i) + end block + block + block + call g1 (1, i) + end block + do j = 1, a2 + block + call f1 (2, j) + end block + block + block + call g1 (2, j) + end block + do k = 1, a3 + call f1 (3, k) + block + call g1 (3, k) + call g2 (3, k) + end block + call f2 (3, k) + end do + block + call g2 (2, j) + end block + end block + block + call f2 (2, j) + end block + end do + block + call g2 (1, i) + end block + end block + block + call f2 (1, i) + end block + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90 new file mode 100644 index 00000000000..608eee7e424 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90 @@ -0,0 +1,72 @@ +! { dg-do run } + +! Like imperfect1.f90, but enables offloading. + +program foo + integer, save :: f1count(3), f2count(3) + !$omp declare target enter (f1count, f2count) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + !$omp atomic + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + !$omp atomic + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count) + do i = 1, a1 + call f1 (1, i) + do j = 1, a2 + call f1 (2, j) + do k = 1, a3 + call f1 (3, k) + call f2 (3, k) + end do + call f2 (2, j) + end do + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90 new file mode 100644 index 00000000000..982661c278a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90 @@ -0,0 +1,110 @@ +! { dg-do run } + +! Like imperfect2.f90, but enables offloading. + +program foo + integer, save :: f1count(3), f2count(3), g1count(3), g2count(3) + !$omp declare target enter (f1count, f2count) + !$omp declare target enter (g1count, g2count) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + !$omp atomic + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + !$omp atomic + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + !$omp atomic + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + !$omp atomic + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count) + do i = 1, a1 + call f1 (1, i) + block + call g1 (1, i) + do j = 1, a2 + call f1 (2, j) + block + call g1 (2, j) + do k = 1, a3 + call f1 (3, k) + block + call g1 (3, k) + call g2 (3, k) + end block + call f2 (3, k) + end do + call g2 (2, j) + end block + call f2 (2, j) + end do + call g2 (1, i) + end block + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90 new file mode 100644 index 00000000000..6f4f92d6f3f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90 @@ -0,0 +1,116 @@ +! { dg-do run } + +! Like imperfect3.f90, but enables offloading. + +program foo + integer, save :: f1count(3), f2count(3), g1count(3), g2count(3) + !$omp declare target enter (f1count, f2count) + !$omp declare target enter (g1count, g2count) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + !$omp atomic + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + !$omp atomic + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + !$omp atomic + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + !$omp atomic + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count) + do i = 1, a1 + call f1 (1, i) + block + integer :: local1 + local1 = 1 + call g1 (local1, i) + do j = 1, a2 + call f1 (2, j) + block + integer :: local2 + local2 = 2 + call g1 (local2, j) + do k = 1, a3 + call f1 (3, k) + block + integer :: local3 + local3 = 3 + call g1 (local3, k) + call g2 (local3, k) + end block + call f2 (3, k) + end do + call g2 (local2, j) + end block + call f2 (2, j) + end do + call g2 (local1, i) + end block + call f2 (1, i) + end do + +end subroutine + +end program diff --git a/libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90 new file mode 100644 index 00000000000..59ec0e92b05 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90 @@ -0,0 +1,126 @@ +! { dg-do run } + +! Like imperfect4.f90, but enables offloading. + +program foo + integer, save :: f1count(3), f2count(3), g1count(3), g2count(3) + !$omp declare target enter (f1count, f2count) + !$omp declare target enter (g1count, g2count) + + f1count(1) = 0 + f1count(2) = 0 + f1count(3) = 0 + f2count(1) = 0 + f2count(2) = 0 + f2count(3) = 0 + + g1count(1) = 0 + g1count(2) = 0 + g1count(3) = 0 + g2count(1) = 0 + g2count(2) = 0 + g2count(3) = 0 + + call s1 (3, 4, 5) + + ! All intervening code at the same depth must be executed the same + ! number of times. + if (f1count(1) /= f2count(1)) error stop 101 + if (f1count(2) /= f2count(2)) error stop 102 + if (f1count(3) /= f2count(3)) error stop 103 + if (g1count(1) /= f1count(1)) error stop 104 + if (g2count(1) /= f1count(1)) error stop 105 + if (g1count(2) /= f1count(2)) error stop 106 + if (g2count(2) /= f1count(2)) error stop 107 + if (g1count(3) /= f1count(3)) error stop 108 + if (g2count(3) /= f1count(3)) error stop 109 + + ! Intervening code must be executed at least as many times as the loop + ! that encloses it. + if (f1count(1) < 3) error stop 111 + if (f1count(2) < 3 * 4) error stop 112 + + ! Intervening code must not be executed more times than the number + ! of logical iterations. + if (f1count(1) > 3 * 4 * 5) error stop 121 + if (f1count(2) > 3 * 4 * 5) error stop 122 + + ! Check that the innermost loop body is executed exactly the number + ! of logical iterations expected. + if (f1count(3) /= 3 * 4 * 5) error stop 131 + +contains + +subroutine f1 (depth, iter) + integer :: depth, iter + !$omp atomic + f1count(depth) = f1count(depth) + 1 +end subroutine + +subroutine f2 (depth, iter) + integer :: depth, iter + !$omp atomic + f2count(depth) = f2count(depth) + 1 +end subroutine + +subroutine g1 (depth, iter) + integer :: depth, iter + !$omp atomic + g1count(depth) = g1count(depth) + 1 +end subroutine + +subroutine g2 (depth, iter) + integer :: depth, iter + !$omp atomic + g2count(depth) = g2count(depth) + 1 +end subroutine + +subroutine s1 (a1, a2, a3) + integer :: a1, a2, a3 + integer :: i, j, k + + !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count) + do i = 1, a1 + block + call f1 (1, i) + end block + block + block + call g1 (1, i) + end block + do j = 1, a2 + block + call f1 (2, j) + end block + block + block + call g1 (2, j) + end block + do k = 1, a3 + call f1 (3, k) + block + call g1 (3, k) + call g2 (3, k) + end block + call f2 (3, k) + end do + block + call g2 (2, j) + end block + end block + block + call f2 (2, j) + end block + end do + block + call g2 (1, i) + end block + end block + block + call f2 (1, i) + end block + end do + +end subroutine + +end program