From patchwork Tue Dec 8 12:13:07 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1412645 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: 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@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com 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 RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4Cqzbq4g6Bz9sVn for ; Tue, 8 Dec 2020 23:13:24 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5D631388A03C; Tue, 8 Dec 2020 12:13:21 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 9120C386100B; Tue, 8 Dec 2020 12:13:15 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 9120C386100B Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: MeCXNP/9DvSFRmV4kSN3LpwQB3bOyBnqCM0cOoiVPr9ak7aqgPQts5EU7p4GavZOUyLh0HXP0G TMIzKkji9o+J51SQ3rHa88vMnw/lCm3x9OHYf6AGR4joKIj8yn3Ifi525irIxMwhH/GxjQHInh a8xrMWpiRfhv5Kc3M3pscq/BKsSv2lXi7en9iqIBEfD4by4MeOK9qithQnOMEI0fZRcATSmBrD ZrmbwQCfpSlXvdGw5feeKMHuCsO56Alw1v35JXDeQuZZKa42BL5Km7KhZgpIbJgfUQ3m0dJrrl bvA= X-IronPort-AV: E=Sophos;i="5.78,402,1599552000"; d="diff'?scan'208";a="55923608" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 08 Dec 2020 04:13:14 -0800 IronPort-SDR: DeKF7UxKFYYzy2AsLz6OXLfRx9IZI4zfrnkZHWsJo2Q5sAREy3IOd9sDa/gsVxzpc3F5yeSYju MVOejJXLOg8zrkl5RYYiebiDR8uoQIzC0yD9RkxvqT9TYnIm06vfEyuA+1FCf9qC5kgbjVa00+ lW7xEz4Kygcyy/2BvQSQ/CRvyCXWolTaaf+oG5RZDvYi/XvI+z+P0e+bkuGMftn8kq9wiUu4UY Tm4524JYqW9rUGr+4tiyEsRht+auGBlRcVid8Z+sIKci7A0+bErEvYZlCff4ijBGY5PmXm3t7F J5I= To: gcc-patches , fortran , Jakub Jelinek From: Tobias Burnus Subject: [Patch] Fortran: Add 'omp scan' support of OpenMP 5.0 Message-ID: <07980ccb-e552-19bc-c55e-abdfc7ca1337@codesourcery.com> Date: Tue, 8 Dec 2020 13:13:07 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.5.1 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-02.mgc.mentorg.com (139.181.222.2) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_NUMSUBJECT, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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@gcc.gnu.org Sender: "Gcc-patches" In a previous patch, the 'inscan' reduction-clause modifier was added. This patch add the associated 'omp scan' for two reasons: First, to make it actually usable and, secondly, to avoid some corner cases where 'inscan' slips through without the required 'sorry' (as it can happen with the current code). (The change to 'gfc_match_omp_taskgroup' is an unrelated cleanup.) This still works with the current list OMP_LIST_* and adds two more items; I still need to update my previous patch to avoid carrying around this long list. The testcases are mostly converted C/C++ test cases; I moved some code as some errors are FE and some are ME errors and currently ME errors only show up if there are no FE errors. OK? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter Fortran: Add 'omp scan' support of OpenMP 5.0 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses, show_omp_node, show_code_node): Handle OMP SCAN. * gfortran.h (enum gfc_statement): Add ST_OMP_SCAN. (enum): Add OMP_LIST_SCAN_IN and OMP_LIST_SCAN_EX. (enum gfc_exec_op): Add EXEC_OMP_SCAN. * match.h (gfc_match_omp_scan): New prototype. * openmp.c (gfc_match_omp_scan): New. (gfc_match_omp_taskgroup): Cleanup. (resolve_omp_clauses, gfc_resolve_omp_do_blocks, omp_code_to_statement, gfc_resolve_omp_directive): Handle 'omp scan'. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Handle EXEC_OMP_SCAN. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_do, gfc_split_omp_clauses): Handle 'omp scan'. libgomp/ChangeLog: * testsuite/libgomp.fortran/scan-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/reduction4.f90: Update; move FE some tests to ... * gfortran.dg/gomp/reduction6.f90: ... this new test and ... * gfortran.dg/gomp/reduction7.f90: ... this new test. * gfortran.dg/gomp/reduction5.f90: Add dg-error. * gfortran.dg/gomp/scan-1.f90: New test. * gfortran.dg/gomp/scan-2.f90: New test. * gfortran.dg/gomp/scan-3.f90: New test. * gfortran.dg/gomp/scan-4.f90: New test. * gfortran.dg/gomp/scan-5.f90: New test. * gfortran.dg/gomp/scan-6.f90: New test. * gfortran.dg/gomp/scan-7.f90: New test. gcc/fortran/dump-parse-tree.c | 7 +- gcc/fortran/gfortran.h | 6 +- gcc/fortran/match.h | 1 + gcc/fortran/openmp.c | 102 ++++++++++-- gcc/fortran/parse.c | 6 +- gcc/fortran/resolve.c | 1 + gcc/fortran/st.c | 1 + gcc/fortran/trans-openmp.c | 40 ++++- gcc/testsuite/gfortran.dg/gomp/reduction4.f90 | 29 +--- gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 7 +- gcc/testsuite/gfortran.dg/gomp/reduction6.f90 | 18 +++ gcc/testsuite/gfortran.dg/gomp/reduction7.f90 | 9 ++ gcc/testsuite/gfortran.dg/gomp/scan-1.f90 | 213 ++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/scan-2.f90 | 21 +++ gcc/testsuite/gfortran.dg/gomp/scan-3.f90 | 21 +++ gcc/testsuite/gfortran.dg/gomp/scan-4.f90 | 22 +++ gcc/testsuite/gfortran.dg/gomp/scan-5.f90 | 18 +++ gcc/testsuite/gfortran.dg/gomp/scan-6.f90 | 16 ++ gcc/testsuite/gfortran.dg/gomp/scan-7.f90 | 60 ++++++++ libgomp/testsuite/libgomp.fortran/scan-1.f90 | 115 ++++++++++++++ 20 files changed, 670 insertions(+), 43 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 1012b11fb98..b3fa1785b14 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1600,6 +1600,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; + case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: gcc_unreachable (); } @@ -1803,6 +1805,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break; case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; + case EXEC_OMP_SCAN: name = "SCAN"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; @@ -1873,6 +1876,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: @@ -1933,7 +1937,7 @@ show_omp_node (int level, gfc_code *c) if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA - || c->op == EXEC_OMP_TARGET_EXIT_DATA + || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -3073,6 +3077,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6467985ea7f..41fed15919f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -261,7 +261,7 @@ enum gfc_statement ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, - ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, @@ -1277,6 +1277,8 @@ enum OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM, + OMP_LIST_SCAN_IN, + OMP_LIST_SCAN_EX, OMP_LIST_REDUCTION, OMP_LIST_REDUCTION_INSCAN, OMP_LIST_REDUCTION_TASK, @@ -2697,7 +2699,7 @@ enum gfc_exec_op EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, - EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 4ccb5961d2b..c771448c184 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -176,6 +176,7 @@ match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_sections (void); match gfc_match_omp_parallel_workshare (void); match gfc_match_omp_requires (void); +match gfc_match_omp_scan (void); match gfc_match_omp_sections (void); match gfc_match_omp_simd (void); match gfc_match_omp_single (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 68d0b65ff87..b6c771bbba6 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3882,6 +3882,42 @@ error: } +match +gfc_match_omp_scan (void) +{ + bool incl; + gfc_omp_clauses *c = gfc_get_omp_clauses (); + gfc_gobble_whitespace (); + if ((incl = (gfc_match ("inclusive") == MATCH_YES)) + || gfc_match ("exclusive") == MATCH_YES) + { + if (gfc_match_omp_variable_list (" (", &c->lists[incl ? OMP_LIST_SCAN_IN + : OMP_LIST_SCAN_EX], + false) != MATCH_YES) + { + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + } + else + { + gfc_error ("Expected INCLUSIVE or EXCLUSIVE clause at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$OMP SCAN at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + + new_st.op = EXEC_OMP_SCAN; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + match gfc_match_omp_sections (void) { @@ -4296,13 +4332,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_TASK_REDUCTION, true, true) - != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_TASKGROUP; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); } @@ -4628,7 +4658,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", - "TO", "FROM", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, + "TO", "FROM", "INCLUSIVE", "EXCLUSIVE", + "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", @@ -4865,6 +4896,15 @@ 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); for (list = 0; list < OMP_LIST_NUM; list++) if (list != OMP_LIST_FIRSTPRIVATE @@ -4982,6 +5022,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + bool has_inscan = false, has_notinscan = false; for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) { @@ -5289,6 +5330,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, || list == OMP_LIST_REDUCTION_TASK || list == OMP_LIST_IN_REDUCTION || list == OMP_LIST_TASK_REDUCTION); + if (list == OMP_LIST_REDUCTION) + has_inscan = true; + else if (is_reduction) + has_notinscan = true; + if (has_inscan && has_notinscan && is_reduction) + { + gfc_error ("% and non-% % " + "clauses on the same construct %L", + &n->where); + break; + } if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object %qs in %s clause at %L", n->sym->name, name, &n->where); @@ -6151,6 +6203,28 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) } if (i < omp_current_do_collapse || omp_current_do_collapse <= 0) omp_current_do_collapse = 1; + if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + 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); + if (!c->block + || !c->block->next + || !c->block->next->next + || c->block->next->next->op != EXEC_OMP_SCAN + || !c->block->next->next->next + || c->block->next->next->next->next) + gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN " + "between two structured-block-sequences", loc); + else + /* Mark as checked; flag will be unset later. */ + c->block->next->next->ext.omp_clauses->if_present = true; + } } gfc_resolve_blocks (code->block, ns); omp_current_do_collapse = 0; @@ -6534,6 +6608,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DISTRIBUTE_SIMD; case EXEC_OMP_DO_SIMD: return ST_OMP_DO_SIMD; + case EXEC_OMP_SCAN: + return ST_OMP_SCAN; case EXEC_OMP_SIMD: return ST_OMP_SIMD; case EXEC_OMP_TARGET: @@ -6972,7 +7048,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) of each directive. */ void -gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) +gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) { resolve_omp_directive_inside_oacc_region (code); @@ -7046,6 +7122,14 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) gfc_error ("OMP CRITICAL at %L with HINT clause requires a NAME, " "except when omp_sync_hint_none is used", &code->loc); break; + case EXEC_OMP_SCAN: + /* Flag is only used to checking, hence, it is unset afterwards. */ + if (!code->ext.omp_clauses->if_present) + gfc_error ("Unexpected !$OMP SCAN at %L outside loop construct with " + "% REDUCTION clause", &code->loc); + code->ext.omp_clauses->if_present = false; + resolve_omp_clauses (code, code->ext.omp_clauses, ns); + break; default: break; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ec7abc240d6..fe0fffd0d1a 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -999,6 +999,7 @@ decode_omp_directive (void) matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES); break; case 's': + matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN); matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION); matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); @@ -1590,7 +1591,7 @@ next_statement (void) case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ - case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ case ST_END_TEAM: case ST_SYNC_TEAM: \ @@ -2447,6 +2448,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_REQUIRES: p = "!$OMP REQUIRES"; break; + case ST_OMP_SCAN: + p = "!$OMP SCAN"; + break; case ST_OMP_SECTIONS: p = "!$OMP SECTIONS"; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0a8f90775ab..327dffbebf2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12184,6 +12184,7 @@ start: case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index a3b0f12b171..d5bccb80f03 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -231,6 +231,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 6b4ad6a7050..ae290648b99 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2334,6 +2334,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_NONTEMPORAL: clause_code = OMP_CLAUSE_NONTEMPORAL; goto add_clause; + case OMP_LIST_SCAN_IN: + clause_code = OMP_CLAUSE_INCLUSIVE; + goto add_clause; + case OMP_LIST_SCAN_EX: + clause_code = OMP_CLAUSE_EXCLUSIVE; + goto add_clause; add_clause: omp_clauses @@ -4707,7 +4713,31 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, code->exit_label = NULL_TREE; /* Main loop body. */ - tmp = gfc_trans_omp_code (code->block->next, true); + if (clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + gcc_assert (code->block->next->next->op == EXEC_OMP_SCAN); + gcc_assert (code->block->next->next->next->next == NULL); + locus *cloc = &code->block->next->next->loc; + location_t loc = gfc_get_location (cloc); + + gfc_code code2 = *code->block->next; + code2.next = NULL; + tmp = gfc_trans_code (&code2); + tmp = build2 (OMP_SCAN, void_type_node, tmp, NULL_TREE); + SET_EXPR_LOCATION (tmp, loc); + gfc_add_expr_to_block (&body, tmp); + input_location = loc; + tree c = gfc_trans_omp_clauses (&body, + code->block->next->next->ext.omp_clauses, + *cloc); + code2 = *code->block->next->next->next; + code2.next = NULL; + tmp = gfc_trans_code (&code2); + tmp = build2 (OMP_SCAN, void_type_node, tmp, c); + SET_EXPR_LOCATION (tmp, loc); + } + else + tmp = gfc_trans_omp_code (code->block->next, true); gfc_add_expr_to_block (&body, tmp); /* Label for cycle statements (if needed). */ @@ -5234,13 +5264,15 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; /* Reduction is allowed on simd, do, parallel and teams. Duplicate it on all of them, but omit on do if - parallel is present. */ + parallel is present; additionally, inscan applies to do/simd only. */ for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++) { - if (mask & GFC_OMP_MASK_TEAMS) + if (mask & GFC_OMP_MASK_TEAMS + && i != OMP_LIST_REDUCTION_INSCAN) clausesa[GFC_OMP_SPLIT_TEAMS].lists[i] = code->ext.omp_clauses->lists[i]; - if (mask & GFC_OMP_MASK_PARALLEL) + if (mask & GFC_OMP_MASK_PARALLEL + && i != OMP_LIST_REDUCTION_INSCAN) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] = code->ext.omp_clauses->lists[i]; else if (mask & GFC_OMP_MASK_DO) diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 index af8c91b2a87..f1c4aecc860 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 @@ -28,7 +28,7 @@ do i=1,10 end do !$omp end parallel -!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'parallel' construct" } +!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } do i=1,10 a = a + 1 end do @@ -45,16 +45,6 @@ do i=1,10 a = a + 1 end do -!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" } -do i=1,10 - a = a + 1 -end do - -!$omp simd reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause but not in 'scan' directive clause" } -do i=1,10 - a = a + 1 -end do - ! ------------ do ------------ !$omp parallel !$omp do reduction(+:a) @@ -77,13 +67,6 @@ do i=1,10 end do !$omp end parallel -!$omp parallel -!$omp do reduction(inscan,+:a) ! { dg-error "'a' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" } -do i=1,10 - a = a + 1 -end do -!$omp end parallel - ! ------------ section ------------ !$omp parallel !$omp sections reduction(+:a) @@ -107,7 +90,7 @@ end do !$omp end parallel !$omp parallel -!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'sections' construct" } +!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } !$omp section a = a + 1 !$omp end sections @@ -119,12 +102,12 @@ end do !$omp end task ! ------------ taskloop ------------ -!$omp taskloop reduction(+:a) in_reduction(+:b) +!$omp taskloop reduction(+:a) in_reduction(+:b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } do i=1,10 a = a + 1 end do -!$omp taskloop reduction(default,+:a) in_reduction(+:b) +!$omp taskloop reduction(default,+:a) in_reduction(+:b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } do i=1,10 a = a + 1 end do @@ -152,9 +135,8 @@ end do end ! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(\\\+:a\\)" 2 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(task,\\\+:a\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 8 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 7 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(\\\+:a\\)" 2 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(task,\\\+:a\\)" 1 "original" } } @@ -163,7 +145,6 @@ end ! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(task,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(\\\+:a\\)" 2 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(task,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp target in_reduction\\(\\\+:b\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp task in_reduction\\(\\\+:a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 index df915f1cad4..61b973f028b 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 @@ -20,7 +20,9 @@ end do a = a + 1 !$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" } -!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "34: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 } + ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-2 } do i=1,10 a = a + 1 end do @@ -30,7 +32,8 @@ do i=1,10 a = a + 1 end do -!$omp teams reduction(inscan,+:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +!$omp teams reduction(inscan,+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-1 } a = a + 1 !$omp end teams diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 new file mode 100644 index 00000000000..6bf685130ab --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } + +implicit none +integer :: a, b, i +a = 0 + +!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } +do i=1,10 + a = a + 1 +end do + +!$omp parallel +!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } +do i=1,10 + a = a + 1 +end do +!$omp end parallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 new file mode 100644 index 00000000000..7dc50e1ac69 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 @@ -0,0 +1,9 @@ +implicit none +integer :: a, b, i +a = 0 + +!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" } +do i=1,10 + a = a + 1 +end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 new file mode 100644 index 00000000000..8c879fd98b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 @@ -0,0 +1,213 @@ +module m + integer a, b +end module m + +subroutine f1 + use m + !$omp scan inclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } + !$omp scan exclusive (b) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } +end + +subroutine f2 (c, d, e, f) + use m + implicit none + integer i, l, c(*), d(*), e(64), f(64) + l = 1 + + !$omp do reduction (inscan, +: a) reduction (+: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } + do i = 1, 64 + block + b = b + 1 + a = a + c(i) + end block + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (+: a) reduction (inscan, +: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } + do i = 1, 64 + block + a = a + 1 + b = b + c(i) + end block + !$omp scan inclusive (b) + d(i) = b + end do + + !$omp do reduction (inscan, +: e) + do i = 1, 64 + block + e(1) = e(1) + c(i) + e(2) = e(2) + c(i) + end block + !$omp scan inclusive (a, e) + block + d(1) = e(1) + f(2) = e(2) + end block + end do + + !$omp do reduction (inscan, +: e(:2)) ! { dg-error "Syntax error in OpenMP variable list" } + do i = 1, 64 + block + e(1) = e(1) + c(i) + e(2) = e(2) + c(i) + end block + !$omp scan inclusive (a, e) ! { dg-error "outside loop construct with 'inscan' REDUCTION clause" } + block + d(1) = e(1) + f(2) = e(2) + end block + end do + + !$omp do reduction (inscan, +: a) ordered ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) ordered(1) ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(static) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(static, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(nonmonotonic: dynamic, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do +end + +subroutine f3 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp teams reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause at" } + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + ! ... + !$omp end teams + + !$omp target parallel do reduction (inscan, +: a) map (c, d) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + !$omp teams + !$omp distribute parallel do reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + !$omp end teams + + !$omp distribute parallel do simd reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f4 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp taskloop reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f7 + use m + implicit none + integer i + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + if (i == 23) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 } + cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } } + elseif (i == 27) then + goto 123 ! Diagnostic by ME, see scan-7.f90 + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + endif + !$omp scan exclusive (a) + block +123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + if (i == 33) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 } + cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } } + end if + end block + end do +end + +subroutine f8 (c, d, e, f) + use m + implicit none + integer i, c(64), d(64), e(64), f(64) + !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + block + a = a + c(i) + b = b + d(i) + end block + !$omp scan inclusive (a) inclusive (b) ! { dg-error "Unexpected junk after ..OMP SCAN" } + block + e(i) = a + f(i) = b + end block + end do + + !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + block + a = a + c(i) + b = b + d(i) + end block + !$omp scan ! { dg-error "Expected INCLUSIVE or EXCLUSIVE clause" } + block + e(i) = a + f(i) = b + end block + end do +end + +subroutine f9 + use m + implicit none + integer i +! The first error (exit) causes two follow-up errors: + !$omp simd reduction (inscan, +: a) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + if (i == 23) & + exit ! { dg-error "EXIT statement at .1. terminating ..OMP DO loop" } */ + !$omp scan exclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } + a = a + 1 + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 new file mode 100644 index 00000000000..c0572321e51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer :: a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer i, c(*), d(*) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 new file mode 100644 index 00000000000..83181666462 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer :: a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer i, c(*), d(*) + !$omp do reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan inclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 new file mode 100644 index 00000000000..c9e9d7e57c9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer c(*), d(*), i + !$omp do simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 new file mode 100644 index 00000000000..a3789a5868a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +integer function foo(a,b, n) result(r) + implicit none + integer :: a(n), b(n), n, i + r = 0 + !$omp parallel do reduction (inscan, +:r) default(none) firstprivate (a, b) + do i = 1, n + r = r + a(i) + !$omp scan inclusive (r) + b(i) = r + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp parallel firstprivate\\(a\\) firstprivate\\(b\\) default\\(none\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:r\\) nowait" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(r\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 new file mode 100644 index 00000000000..35d5869ac1c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 @@ -0,0 +1,16 @@ +module m + integer a, b +end module m + +subroutine f3 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp parallel reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! ... + !$omp end parallel + !$omp sections reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + !$omp section + ! ... + !$omp end sections +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 new file mode 100644 index 00000000000..0446c5eee2b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 @@ -0,0 +1,60 @@ +module m + integer a, b +end module m + +subroutine f2 (c, d, e, f) + use m + implicit none + integer i, l, c(*), d(*), e(64), f(64) + l = 1 + + !$omp do reduction (inscan, +: a) linear (l) ! { dg-error "'inscan' 'reduction' clause used together with 'linear' clause for a variable other than loop iterator" } + do i = 1, 64 + block + a = a + c(i) + l = l + 1 + end block + !$omp scan inclusive (a) + d(i) = a + end do +end + +subroutine f5 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a, b) ! { dg-error "'b' specified in 'exclusive' clause but not in 'inscan' 'reduction' clause on the containing construct" } + a = a + c(i) + end do +end + +subroutine f6 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp simd reduction (inscan, +: a, b) ! { dg-error "'b' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f7 + use m + implicit none + integer i + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + if (i == 27) goto 123 ! { dg-error "invalid branch to/from OpenMP structured block" } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + !$omp scan exclusive (a) + block +123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + end block + end do +end diff --git a/libgomp/testsuite/libgomp.fortran/scan-1.f90 b/libgomp/testsuite/libgomp.fortran/scan-1.f90 new file mode 100644 index 00000000000..a6f8ef7ea76 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/scan-1.f90 @@ -0,0 +1,115 @@ +! { dg-require-effective-target size32plus } + +module m + implicit none + integer r, a(1024), b(1024) +contains +subroutine foo (a, b) + integer, contiguous :: a(:), b(:) + integer :: i + !$omp do reduction (inscan, +:r) + do i = 1, 1024 + r = r + a(i) + !$omp scan inclusive(r) + b(i) = r + end do +end + +integer function bar () + integer s, i + s = 0 + !$omp parallel + !$omp do reduction (inscan, +:s) + do i = 1, 1024 + s = s + 2 * a(i) + !$omp scan inclusive(s) + b(i) = s + end do + !$omp end parallel + bar = s +end + +subroutine baz (a, b) + integer, contiguous :: a(:), b(:) + integer :: i + !$omp parallel do reduction (inscan, +:r) + do i = 1, 1024 + r = r + a(i) + !$omp scan inclusive(r) + b(i) = r + end do +end + +integer function qux () + integer s, i + s = 0 + !$omp parallel do reduction (inscan, +:s) + do i = 1, 1024 + s = s + 2 * a(i) + !$omp scan inclusive(s) + b(i) = s + end do + qux = s +end +end module m + +program main + use m + implicit none + + integer s, i + s = 0 + do i = 1, 1024 + a(i) = i-1 + b(i) = -1 + end do + + !$omp parallel + call foo (a, b) + !$omp end parallel + if (r /= 1024 * 1023 / 2) & + stop 1 + do i = 1, 1024 + s = s + i-1 + if (b(i) /= s) then + stop 2 + else + b(i) = 25 + endif + end do + + if (bar () /= 1024 * 1023) & + stop 3 + s = 0 + do i = 1, 1024 + s = s + 2 * (i-1) + if (b(i) /= s) then + stop 4 + else + b(i) = -1 + end if + end do + + r = 0 + call baz (a, b) + if (r /= 1024 * 1023 / 2) & + stop 5 + s = 0 + do i = 1, 1024 + s = s + i-1 + if (b(i) /= s) then + stop 6 + else + b(i) = -25 + endif + end do + + if (qux () /= 1024 * 1023) & + stop 6 + s = 0 + do i = 1, 1024 + s = s + 2 * (i-1) + if (b(i) /= s) & + stop 7 + end do +end program