From patchwork Wed Jun 14 22:08:04 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 108160 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:994d:0:b0:3d9:f83d:47d9 with SMTP id k13csp256287vqr; Wed, 14 Jun 2023 15:13:27 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ6e4vClhxS8eICPuzBLqyDZuSLM2MbfT3FKtUPPfXy3+X9v+QAvim8UUT9dis7LXLUdOZ4d X-Received: by 2002:a17:907:7e97:b0:978:67a4:64d3 with SMTP id qb23-20020a1709077e9700b0097867a464d3mr16075802ejc.63.1686780807116; Wed, 14 Jun 2023 15:13:27 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1686780807; cv=none; d=google.com; s=arc-20160816; b=w+IXfHUGvXOS6Ds/ceyZiiBT+bQkhshQ9SE4h0MqsF7Y7Kaste39n937ukAUhdlCvC wUHZbZQyShxEj10LHBQUjaBYyQaGUerM592vjhXVOJQkXRQtfB0Hn/9aFBbh1DF9ccyn ZjVcHzxz7p1oFZ+hcJkXVTbPPu9A8zUJtDOe8bx7TmL281lEuzBKe0ljirUYfrsL09F6 2QI4OJzhGSMCa+aurGpgwQs4Dd4rVWv+YbtDPXhw8pGG9uzKH4HIjHSQN7YWPH5L9F6H 9dVIQbRO+2kG6ZjXMCB2urX5DN2r7ueBeoXMByTLZ488C2oUlmbOoLOVnJfr39VoFNSz MtoA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:content-transfer-encoding :mime-version:references:in-reply-to:message-id:date:subject:to:from :ironport-sdr:dmarc-filter:delivered-to; bh=jYH0A73LumO98x2cXCyOTOSAsiJo/XF+TlzLb106YSE=; b=q4a/+tgCFLgovkSVNtLUoU8ZgisEJUObZecIkwRaDynT8L3r/trKN/0rL0USovifBF qu2xuCHP1NEHtc0XqrzWivcaMgoRozCT7vUOhSXZihy1zWtVP93r8B5LNAzzs00SWdAj PgqLgVC7af4XQVNUQdaO3yvLcnf2glD4P95cFol2zz8hGfkadH17YPiH/wjOdEpgdqTj X7rBS1FwztkwUhkhVPQIbE+1HEMTBGf975waHuZZPH0cyeJ9qlQh1c7W1dBADOViNx1v WENvFNe5/OW7uqzY/mBnwgzAd358RI4CO8COho/Slot2woLW8deAr0PjD/OTPyx+K08w TEZw== ARC-Authentication-Results: i=1; mx.google.com; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org" Received: from sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id c19-20020a170906925300b009750bbd87d4si9288081ejx.132.2023.06.14.15.13.26 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 14 Jun 2023 15:13:27 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org" Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 498143856DD0 for ; Wed, 14 Jun 2023 22:10:51 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 295B83854831 for ; Wed, 14 Jun 2023 22:09:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 295B83854831 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="6.00,243,1681200000"; d="scan'208";a="8842000" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 14 Jun 2023 14:09:49 -0800 IronPort-SDR: ESZl2NUrC4qf1Vey1IlsgDLEHf48rGbOQFq49BoyYiKlzANpktBwlZlFgg/jM9vWR+8R1RycZH QUS2MEvcrYZ0fa32txS4IhTnoOryamjlUO5cCx76jb1Q7RMedeGoFxmmJmB1nuzBUp3mjue08S lPjaqbmpOy6qLJV83Ft/DoLzlBzsNX0WixtIX6VB40B6+CId2t5kbF0HjmbT1c3q2s5a+v0sVW tyWxX9bcskpMjlG9jmgYstVJe15QsLwpmuMDsbQK1hV2H2BzS4+jfNZLBPO51FR/buMPQ+D4+x QHA= From: Sandra Loosemore To: Subject: [OG13 6/6] OpenMP: Fortran support for imperfectly nested loops Date: Wed, 14 Jun 2023 16:08:04 -0600 Message-ID: <20230614220804.917436-7-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20230614220804.917436-1-sandra@codesourcery.com> References: <20230614220804.917436-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) 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+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1768717871463313330?= X-GMAIL-MSGID: =?utf-8?q?1768717871463313330?= 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. (scan_for_next_loop_in_chain): New. (scan_for_next_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. (resolve_nested_loops): Update error handling, and extend to detect imperfect nesting errors and check validity of intervening code. Call restructure_intervening_code if needed. (resolve_omp_do): Rename collapse -> count. 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. * gfortran.dg/gomp/loop-transforms/tile-1.f90: Adjust expected errors. * gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise. * gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90: Likewise. libgomp/ChangeLog * testsuite/libgomp.fortran/imperfect-destructor.f90: New. * testsuite/libgomp.fortran/imperfect-transform-1.f90: New. * testsuite/libgomp.fortran/imperfect-transform-2.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/target-imperfect-transform-1.f90: New. * testsuite/libgomp.fortran/target-imperfect-transform-2.f90: New. * testsuite/libgomp.fortran/target-imperfect1.f90: New. * testsuite/libgomp.fortran/target-imperfect2.f90: New. * testsuite/libgomp.fortran/target-imperfect3.f90: New. * testsuite/libgomp.fortran/target-imperfect4.f90: New. --- gcc/fortran/ChangeLog.omp | 23 + gcc/fortran/openmp.cc | 668 +++++++++++++++--- gcc/testsuite/ChangeLog.omp | 13 + gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +- 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 ++ .../gomp/loop-transforms/tile-1.f90 | 12 +- .../gomp/loop-transforms/tile-2.f90 | 2 +- .../loop-transforms/tile-imperfect-nest.f90 | 16 +- libgomp/ChangeLog.omp | 16 + .../libgomp.fortran/imperfect-destructor.f90 | 142 ++++ .../libgomp.fortran/imperfect-transform-1.f90 | 70 ++ .../libgomp.fortran/imperfect-transform-2.f90 | 70 ++ .../testsuite/libgomp.fortran/imperfect1.f90 | 67 ++ .../testsuite/libgomp.fortran/imperfect2.f90 | 102 +++ .../testsuite/libgomp.fortran/imperfect3.f90 | 110 +++ .../testsuite/libgomp.fortran/imperfect4.f90 | 121 ++++ .../target-imperfect-transform-1.f90 | 73 ++ .../target-imperfect-transform-2.f90 | 73 ++ .../libgomp.fortran/target-imperfect1.f90 | 72 ++ .../libgomp.fortran/target-imperfect2.f90 | 110 +++ .../libgomp.fortran/target-imperfect3.f90 | 116 +++ .../libgomp.fortran/target-imperfect4.f90 | 126 ++++ 27 files changed, 2125 insertions(+), 116 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/imperfect-transform-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-transform-2.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/target-imperfect-transform-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect4.f90 diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 04ed7f88175..26375aca413 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,26 @@ +2023-06-13 Sandra Loosemore + + * openmp.cc: Include omp-api.h. + (resolve_omp_clauses): Consolidate inscan reduction clause conflict + checking here. + (scan_for_next_loop_in_chain): New. + (scan_for_next_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. + (resolve_nested_loops): Update error handling, and extend to + detect imperfect nesting errors and check validity of + intervening code. Call restructure_intervening_code if needed. + (resolve_omp_do): Rename collapse -> count. + 2023-06-13 Sandra Loosemore * openmp.cc (find_nested_loop_in_chain): Move up in file. diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 5ab64b5231f..bdca36e4743 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -31,6 +31,7 @@ along with GCC; see the file COPYING3. If not see #include "target-memory.h" /* For gfc_encode_character. */ #include "bitmap.h" #include "options.h" +#include "omp-api.h" /* For omp_runtime_api_procname. */ static gfc_statement omp_code_to_statement (gfc_code *); @@ -8183,15 +8184,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 @@ -10091,68 +10101,130 @@ find_nested_loop_in_block (gfc_code *block) return find_nested_loop_in_chain (ns->code); } +/* Forward declaration for mutually recursive functions. */ +static gfc_code * +scan_for_next_loop_in_block (gfc_code *block, gfc_code **imperfectp); + +/* Like find_nested_loop_in_chain, but also stop when a loop transform is + found and check for intervening code too. Return the first nested + DO loop or loop transform in CHAIN, and set *IMPERFECTP to the first + intervening code statement if one is found. */ +static gfc_code * +scan_for_next_loop_in_chain (gfc_code *chain, gfc_code **imperfectp) +{ + gfc_code *code; + gfc_code *result = NULL; + + if (!chain) + return NULL; + + for (code = chain; code; code = code->next) + { + /* DO WHILE and DO CONCURRENT are errors, but we need to catch them + here to ensure the right error is diagnosed elsewhere. */ + if (!result + && (code->op == EXEC_DO + || code->op == EXEC_DO_WHILE + || code->op == EXEC_DO_CONCURRENT + || loop_transform_p (code->op))) + result = code; + else if (!result && code->op == EXEC_BLOCK) + { + result = scan_for_next_loop_in_block (code, imperfectp); + /* If no loop in the block, the block itself is intervening code. */ + if (!result && !*imperfectp) + *imperfectp = code; + } + else if (code->op == EXEC_NOP || code->op == EXEC_CONTINUE) + continue; + else if (!*imperfectp) + *imperfectp = code; + if (result && *imperfectp) + break; + } + return result; +} + +/* Like find_nested_loop_in_block, but also checks for intervening code. + Return the first nested DO loop in BLOCK, or NULL if there + isn't one. Sets *IMPERFECTP to the first piece of intervening code. */ +static gfc_code * +scan_for_next_loop_in_block (gfc_code *block, gfc_code **imperfectp) +{ + gfc_namespace *ns; + gcc_assert (block->op == EXEC_BLOCK); + ns = block->ext.block.ns; + gcc_assert (ns); + return scan_for_next_loop_in_chain (ns->code, imperfectp); +} + 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); @@ -10282,13 +10354,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)) @@ -10327,6 +10398,328 @@ 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 OpenMP 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 OpenMP 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 OpenMP 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 count) +{ + 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 || loop_transform_p (code->op)) + { + gfc_code *c = code; + + /* Treat a series of loop transforms as a unit, same as a single + EXEC_DO. CODE is the first and C is the last in the chain. */ + while (loop_transform_p (c->op) && !c->block) + c = c->next; + + gcc_assert (c); + gcc_assert (c->op == EXEC_DO + || (loop_transform_p (c->op) && c->block)); + + /* Cut the transforms and the loop they apply to free from the + chain, leaving the ends dangling. */ + *chainp = NULL; + tail = c->next; + c->next = NULL; + + if (count == 1 && c->op == EXEC_DO) + innermost_loop = c; + else + innermost_loop + = restructure_intervening_code (&(c->block->next), c, + (loop_transform_p (c->op) + ? count : count - 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, + count); + + /* 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 || loop_transform_p (code->op)) && 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. */ @@ -10556,29 +10949,36 @@ static void resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code, int num_loops, bool is_simd, bool is_tile) { + bool errorp = false; + bool perfect_nesting_errorp = false; + bool is_nested_tile = false; + bool any_imperfect = false; + for (int i = 1; i <= num_loops; i++) { gfc_symbol *dovar; gfc_symbol *start_var = NULL, *end_var = NULL; - gfc_code *c; + gfc_code *imperfect = NULL; + gfc_code *next; + /* 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; } if (do_code->op != EXEC_DO) { gfc_error ("%s must be DO loop at %L", name, &do_code->loc); - break; + return; } dovar = do_code->ext.iterator->var->symtree->n.sym; if (!is_tile) @@ -10587,11 +10987,17 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code, gfc_omp_namelist *n; 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; + } 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 @@ -10611,7 +11017,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code, "other than PRIVATE, LASTPRIVATE, " "ALLOCATE or LINEAR at %L", name, &do_code->loc); - break; + errorp = true; } } if (is_outer_iteration_variable (code, i, dovar)) @@ -10619,7 +11025,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code, gfc_error ("%s iteration variable used in more than one loop at %L " "(depth %d)", name, &do_code->loc, i); - break; + errorp = true; } else if (!bound_expr_is_canonical (code, i, do_code->ext.iterator->start, @@ -10627,7 +11033,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_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, @@ -10635,53 +11041,125 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_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 ("%s loops not perfectly nested at %L", - name, &c->loc); - break; - } - if (i == num_loops || c) + if (i == num_loops) break; - do_code = do_code->block->next; - if (do_code) - do_code = resolve_nested_loop_transforms (do_code, name, - num_loops - i, - &code->loc); - if (!do_code - || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) + next = scan_for_next_loop_in_chain (do_code->block->next, &imperfect); + if (!next) { + /* Parse error, can't recover from this. */ gfc_error ("not enough DO loops for %s at %L", name, &code->loc); - break; + return; + } + + /* Only diagnose violation of imperfect nesting constraints once. */ + if (!perfect_nesting_errorp && imperfect) + { + 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; + } + else if (is_tile) + { + gfc_error ("%s inner loops must be perfectly nested at %L", + name, &code->loc); + perfect_nesting_errorp = true; + } + else if (is_nested_tile) + { + gfc_error ("%s inner loops must be perfectly nested with " + "nested !$OMP TILE at %L", + name, &code->loc); + perfect_nesting_errorp = true; + } + if (perfect_nesting_errorp) + errorp = true; + } + + /* Check constraints on intervening code, if we have some. */ + if (imperfect) + { + any_imperfect = true; + if (diagnose_intervening_code_errors (do_code->block->next, + name, next)) + errorp = true; + } + + /* Check for presence of nested TILE directive, used for next level + of the imperfect loop error checking above. Then resolve all the + transforms at this level. */ + if (!is_tile && !is_nested_tile && !perfect_nesting_errorp) + for (gfc_code *c = next; c && loop_transform_p (c->op); ) + { + if (c->op == EXEC_OMP_TILE) + { + is_nested_tile = true; + break; + } + if (c->block) + c = c->block->next; + else + c = c->next; + } + next = resolve_nested_loop_transforms (next, name, num_loops - i, + &code->loc); + if (!next) + { + gfc_error ("not enough DO loops for %s at %L", + name, &code->loc); + return; } + + do_code = next; } + + /* Give up now if we found any constraint violations. */ + if (errorp) + return; + + /* Only restructure intervening code if we found some. Note that + restructure_intervening_code assumes CODE is a DO loop instead of a + top-level TILE directive, which should have been rejected already if + if contains intervening code. */ + if (is_tile) + gcc_assert (!any_imperfect); + if (any_imperfect) + restructure_intervening_code (&(code->block->next), code, num_loops); } static void resolve_omp_do (gfc_code *code) { gfc_code *do_code; - int collapse; + int count; const char *name; bool is_simd = false; @@ -10787,15 +11265,15 @@ resolve_omp_do (gfc_code *code) resolve_omp_clauses (code, code->ext.omp_clauses, NULL); if (code->ext.omp_clauses->orderedc) - collapse = code->ext.omp_clauses->orderedc; + count = code->ext.omp_clauses->orderedc; else { - collapse = code->ext.omp_clauses->collapse; - if (collapse <= 0) - collapse = 1; + count = code->ext.omp_clauses->collapse; + if (count <= 0) + count = 1; } - do_code = resolve_nested_loop_transforms (code->block->next, name, collapse, + do_code = resolve_nested_loop_transforms (code->block->next, name, count, &code->loc); /* While the spec defines the loop nest depth independently of the COLLAPSE @@ -10803,7 +11281,7 @@ resolve_omp_do (gfc_code *code) depth and treats any further inner loops as the final-loop-body. So here we also check canonical loop nest form only for the number of outer loops specified by the COLLAPSE clause too. */ - resolve_nested_loops (code, name, do_code, collapse, is_simd, false); + resolve_nested_loops (code, name, do_code, count, is_simd, false); } static void diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 24a8bc43b10..810f1e6c929 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,16 @@ +2023-06-13 Sandra Loosemore + + * 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. + * gfortran.dg/gomp/loop-transforms/tile-1.f90: Adjust expected errors. + * gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise. + * gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90: Likewise. + 2023-06-13 Sandra Loosemore * gfortran.dg/gomp/collapse1.f90: Adjust expected error message. diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index d938e1b569d..485922569b3 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -31,7 +31,7 @@ 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) do i = 1, 3 diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 index 0aa7d9391e5..60c1d7c0813 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 with ORDERED clause" } 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" } + !$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" } + !$omp parallel do ordered(2) ! { dg-error "inner loops must be perfectly nested with ORDERED clause" } 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..4e750d9ad05 --- /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 "OpenMP 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..d02191050d9 --- /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 "OpenMP 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 "OpenMP 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/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90 index 84ea93300fa..be3dd1e400c 100644 --- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90 @@ -117,29 +117,29 @@ subroutine test end do !$end omp tile - !$omp tile sizes(1,2,1) + !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do i = 1,100 do j = 1,100 do k = 1,100 call dummy(i) end do end do - call dummy(i) ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} } + call dummy(i) end do !$end omp tile - !$omp tile sizes(1,2,1) + !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do i = 1,100 do j = 1,100 do k = 1,100 call dummy(i) end do - call dummy(j) ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} } + call dummy(j) end do end do !$end omp tile - !$omp tile sizes(1,2,1) ! { dg-error {not enough DO loops for \!\$OMP TILE at \(1\)} } + !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do i = 1,100 call dummy(i) do j = 1,100 @@ -150,7 +150,7 @@ subroutine test end do !$end omp tile - !$omp tile sizes(1,2,1) ! { dg-error {not enough DO loops for \!\$OMP TILE at \(1\)} } + !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do i = 1,100 do j = 1,100 call dummy(j) diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 index f4c24f76eac..d14af08c27a 100644 --- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 @@ -64,7 +64,7 @@ subroutine test3 implicit none integer :: i, j, k - !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for \!\$OMP TASKLOOP at \(1\)} } + !$omp taskloop collapse(3) !$omp tile sizes (1,2) ! { dg-error {loop nest depth after \!\$OMP TILE at \(1\) is insufficient for outer \!\$OMP TASKLOOP} } !$omp tile sizes (1,2) do i = 1,100 diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90 index 3ec1671f01f..977a39af9da 100644 --- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90 @@ -21,7 +21,7 @@ subroutine test0m integer :: i, j, k, inner !$omp parallel do collapse(2) private(inner) do i = 1,m - !$omp tile sizes (8, 1) + !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do j = 1,n do k = 1, n if (k == 1) then @@ -29,7 +29,7 @@ subroutine test0m endif inner = inner + a(k, i) * b(j, k) end do - c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} } + c(j, i) = inner end do end do end subroutine test0m @@ -40,7 +40,7 @@ subroutine test1 !$omp parallel do collapse(2) private(inner) !$omp tile sizes (8, 1) do i = 1,m - !$omp tile sizes (8, 1) + !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do j = 1,n !$omp unroll partial(10) do k = 1, n @@ -49,7 +49,7 @@ subroutine test1 endif inner = inner + a(k, i) * b(j, k) end do - c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} "TODO Fix with upcoming imperfect loop nest handling" { xfail *-*-* } } + c(j, i) = inner end do end do end subroutine test1 @@ -61,7 +61,7 @@ subroutine test2 !$omp parallel do collapse(2) private(inner) !$omp tile sizes (8, 1) do i = 1,m - !$omp tile sizes (8, 1) + !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do j = 1,n do k = 1, n if (k == 1) then @@ -69,7 +69,7 @@ subroutine test2 endif inner = inner + a(k, i) * b(j, k) end do - c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} } + c(j, i) = inner end do end do end subroutine test2 @@ -79,7 +79,7 @@ subroutine test3 integer :: i, j, k, inner !$omp parallel do collapse(2) private(inner) do i = 1,m - !$omp tile sizes (8, 1) + !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} } do j = 1,n do k = 1, n if (k == 1) then @@ -87,7 +87,7 @@ subroutine test3 endif inner = inner + a(k, i) * b(j, k) end do - c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} } + c(j, i) = inner end do end do end subroutine test3 diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index cd6dfa6af2d..f740f880934 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,19 @@ +2023-06-13 Sandra Loosemore + + * testsuite/libgomp.fortran/imperfect-destructor.f90: New. + * testsuite/libgomp.fortran/imperfect-transform-1.f90: New. + * testsuite/libgomp.fortran/imperfect-transform-2.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/target-imperfect-transform-1.f90: New. + * testsuite/libgomp.fortran/target-imperfect-transform-2.f90: New. + * testsuite/libgomp.fortran/target-imperfect1.f90: New. + * testsuite/libgomp.fortran/target-imperfect2.f90: New. + * testsuite/libgomp.fortran/target-imperfect3.f90: New. + * testsuite/libgomp.fortran/target-imperfect4.f90: New. + 2023-06-13 Sandra Loosemore * testsuite/libgomp.c-c++-common/imperfect-transform-1.c: New. 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/imperfect-transform-1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90 new file mode 100644 index 00000000000..aa956707414 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90 @@ -0,0 +1,70 @@ +! { dg-do run } + +! Like imperfect1.f90, but also includes loop transforms. + +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) + !$omp unroll partial + 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/imperfect-transform-2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90 new file mode 100644 index 00000000000..be199ab9218 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90 @@ -0,0 +1,70 @@ +! { dg-do run } + +! Like imperfect1.f90, but also includes loop transforms. + +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) + !$omp tile sizes(5) + 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/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/target-imperfect-transform-1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90 new file mode 100644 index 00000000000..34b6e075e05 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90 @@ -0,0 +1,73 @@ +! { dg-do run } + +! Like imperfect-transform.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) + !$omp unroll partial + 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/target-imperfect-transform-2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90 new file mode 100644 index 00000000000..188cca1e5b4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90 @@ -0,0 +1,73 @@ +! { dg-do run } + +! Like imperfect-transform.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) + !$omp tile sizes(5) + 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/target-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90 new file mode 100644 index 00000000000..608eee7e424 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-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/target-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90 new file mode 100644 index 00000000000..982661c278a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-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/target-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90 new file mode 100644 index 00000000000..6f4f92d6f3f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-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/target-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90 new file mode 100644 index 00000000000..59ec0e92b05 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-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