From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 60B8B394D8A4; Tue, 17 Aug 2021 13:51:24 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 60B8B394D8A4 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-2962] Fortran: Implement OpenMP 5.1 scope construct X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/master X-Git-Oldrev: 20698ec5b681e23fa3404ed0ef78e3367b28e16d X-Git-Newrev: f8d535f3fec81c1cc84e22df5500e693544ec65b Message-Id: <20210817135124.60B8B394D8A4@sourceware.org> Date: Tue, 17 Aug 2021 13:51:24 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 17 Aug 2021 13:51:24 -0000 https://gcc.gnu.org/g:f8d535f3fec81c1cc84e22df5500e693544ec65b commit r12-2962-gf8d535f3fec81c1cc84e22df5500e693544ec65b Author: Tobias Burnus Date: Tue Aug 17 15:50:11 2021 +0200 Fortran: Implement OpenMP 5.1 scope construct Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f, which implemented OpenMP's scope construct for C and C++. Most testcases are based on the C testcases; it also contains some testcases which existed previously but had no Fortran equivalent. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_SCOPE. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE. (enum gfc_exec_op): Add EXEC_OMP_SCOPE. * match.h (gfc_match_omp_scope): New. * openmp.c (OMP_SCOPE_CLAUSES): Define (gfc_match_omp_scope): New. (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait): Improve error diagnostic. (omp_code_to_statement): Handle ST_OMP_SCOPE. (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Handle OpenMP's scope construct. * resolve.c (gfc_resolve_blocks): Likewise * st.c (gfc_free_statement): Likewise * trans-openmp.c (gfc_trans_omp_scope): New. (gfc_trans_omp_directive): Call it. * trans.c (trans_code): handle EXEC_OMP_SCOPE. libgomp/ChangeLog: * testsuite/libgomp.fortran/scope-1.f90: New test. * testsuite/libgomp.fortran/task-reduction-16.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/scan-1.f90: * gfortran.dg/gomp/cancel-1.f90: New test. * gfortran.dg/gomp/cancel-4.f90: New test. * gfortran.dg/gomp/loop-4.f90: New test. * gfortran.dg/gomp/nesting-1.f90: New test. * gfortran.dg/gomp/nesting-2.f90: New test. * gfortran.dg/gomp/nesting-3.f90: New test. * gfortran.dg/gomp/nowait-1.f90: New test. * gfortran.dg/gomp/reduction-task-1.f90: New test. * gfortran.dg/gomp/reduction-task-2.f90: New test. * gfortran.dg/gomp/reduction-task-2a.f90: New test. * gfortran.dg/gomp/reduction-task-3.f90: New test. * gfortran.dg/gomp/scope-1.f90: New test. * gfortran.dg/gomp/scope-2.f90: New test. Diff: --- gcc/fortran/dump-parse-tree.c | 3 + gcc/fortran/gfortran.h | 4 +- gcc/fortran/match.h | 1 + gcc/fortran/openmp.c | 23 +- gcc/fortran/parse.c | 13 +- gcc/fortran/resolve.c | 2 + gcc/fortran/st.c | 1 + gcc/fortran/trans-openmp.c | 20 + gcc/fortran/trans.c | 1 + gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 | 539 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 | 9 + gcc/testsuite/gfortran.dg/gomp/loop-4.f90 | 279 +++++++++++ gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 | 68 +++ gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 | 165 +++++++ gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 | 347 +++++++++++++ gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 | 19 + .../gfortran.dg/gomp/reduction-task-1.f90 | 112 +++++ .../gfortran.dg/gomp/reduction-task-2.f90 | 45 ++ .../gfortran.dg/gomp/reduction-task-2a.f90 | 30 ++ .../gfortran.dg/gomp/reduction-task-3.f90 | 15 + gcc/testsuite/gfortran.dg/gomp/scan-1.f90 | 5 + gcc/testsuite/gfortran.dg/gomp/scope-1.f90 | 39 ++ gcc/testsuite/gfortran.dg/gomp/scope-2.f90 | 40 ++ libgomp/testsuite/libgomp.fortran/scope-1.f90 | 55 +++ .../libgomp.fortran/task-reduction-16.f90 | 82 ++++ 25 files changed, 1911 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 53c49fe4d6f..92d9f9e054d 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1977,6 +1977,7 @@ show_omp_node (int level, gfc_code *c) 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_SCOPE: name = "SCOPE"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; @@ -2060,6 +2061,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SCAN: + case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: @@ -3288,6 +3290,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SCAN: + case EXEC_OMP_SCOPE: 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 5fde4174a5b..a7d82ae38c2 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -281,7 +281,7 @@ enum gfc_statement ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP, ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD, - ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_NONE + ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, ST_NONE }; /* Types of interfaces that we can have. Assignment interfaces are @@ -2768,7 +2768,7 @@ enum gfc_exec_op EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP, EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED, EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD, - EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD + EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index dce650346d3..aac16a8d3d0 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -190,6 +190,7 @@ match gfc_match_omp_parallel_master_taskloop_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_scope (void); match gfc_match_omp_scan (void); match gfc_match_omp_sections (void); match gfc_match_omp_simd (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1bce43cb33e..9675b658409 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3150,6 +3150,8 @@ cleanup: #define OMP_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) +#define OMP_SCOPE_CLAUSES \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) @@ -4487,6 +4489,13 @@ gfc_match_omp_scan (void) } +match +gfc_match_omp_scope (void) +{ + return match_omp (EXEC_OMP_SCOPE, OMP_SCOPE_CLAUSES); +} + + match gfc_match_omp_sections (void) { @@ -4975,7 +4984,11 @@ gfc_match_omp_cancellation_point (void) gfc_omp_clauses *c; enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); if (kind == OMP_CANCEL_UNKNOWN) - return MATCH_ERROR; + { + gfc_error ("Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP " + "in $OMP CANCELLATION POINT statement at %C"); + return MATCH_ERROR; + } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement " @@ -4998,7 +5011,10 @@ gfc_match_omp_end_nowait (void) nowait = true; if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after NOWAIT clause at %C"); + if (nowait) + gfc_error ("Unexpected junk after NOWAIT clause at %C"); + else + gfc_error ("Unexpected junk at %C"); return MATCH_ERROR; } new_st.op = EXEC_OMP_END_NOWAIT; @@ -7448,6 +7464,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DO_SIMD; case EXEC_OMP_SCAN: return ST_OMP_SCAN; + case EXEC_OMP_SCOPE: + return ST_OMP_SCOPE; case EXEC_OMP_SIMD: return ST_OMP_SIMD; case EXEC_OMP_TARGET: @@ -7948,6 +7966,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL_MASKED: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index e1d78de5d9e..24cc9bfb9f1 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -951,6 +951,7 @@ decode_omp_directive (void) matcho ("end parallel workshare", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_WORKSHARE); matcho ("end parallel", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL); + matcho ("end scope", gfc_match_omp_end_nowait, ST_OMP_END_SCOPE); matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); matcho ("end target data", gfc_match_omp_eos_error, ST_OMP_END_TARGET_DATA); @@ -1052,6 +1053,7 @@ decode_omp_directive (void) break; case 's': matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN); + matcho ("scope", gfc_match_omp_scope, ST_OMP_SCOPE); 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); @@ -1672,7 +1674,7 @@ next_statement (void) case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP: \ case ST_OMP_MASKED_TASKLOOP_SIMD: \ case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \ - case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SINGLE: \ + case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \ @@ -2609,6 +2611,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_SCAN: p = "!$OMP SCAN"; break; + case ST_OMP_SCOPE: + p = "!$OMP SCOPE"; + break; case ST_OMP_SECTIONS: p = "!$OMP SECTIONS"; break; @@ -5463,6 +5468,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_PARALLEL_SECTIONS: omp_end_st = ST_OMP_END_PARALLEL_SECTIONS; break; + case ST_OMP_SCOPE: + omp_end_st = ST_OMP_END_SCOPE; + break; case ST_OMP_SECTIONS: omp_end_st = ST_OMP_END_SECTIONS; break; @@ -5763,11 +5771,12 @@ parse_executable (gfc_statement st) case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: case ST_OMP_PARALLEL_SECTIONS: - case ST_OMP_SECTIONS: case ST_OMP_ORDERED: case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASTER: + case ST_OMP_SCOPE: + case ST_OMP_SECTIONS: case ST_OMP_SINGLE: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8eb8a9ab6d7..117062b48d8 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10839,6 +10839,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: + case EXEC_OMP_SCOPE: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: @@ -12262,6 +12263,7 @@ start: case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: case EXEC_OMP_SCAN: + case EXEC_OMP_SCOPE: 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 f61f88adcc5..7d87709d387 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -246,6 +246,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SCAN: + case EXEC_OMP_SCOPE: 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 623c21fc790..e0a001420e6 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -6264,6 +6264,24 @@ gfc_trans_omp_parallel_workshare (gfc_code *code) return gfc_finish_block (&block); } +static tree +gfc_trans_omp_scope (gfc_code *code) +{ + stmtblock_t block; + tree body = gfc_trans_code (code->block->next); + if (IS_EMPTY_STMT (body)) + return body; + gfc_start_block (&block); + tree omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + tree stmt = make_node (OMP_SCOPE); + TREE_TYPE (stmt) = void_type_node; + OMP_SCOPE_BODY (stmt) = body; + OMP_SCOPE_CLAUSES (stmt) = omp_clauses; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + static tree gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses) { @@ -7110,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: return gfc_trans_omp_parallel_workshare (code); + case EXEC_OMP_SCOPE: + return gfc_trans_omp_scope (code); case EXEC_OMP_SECTIONS: return gfc_trans_omp_sections (code, code->ext.omp_clauses); case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index ce5b2f8d594..80b724d0839 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2175,6 +2175,7 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 new file mode 100644 index 00000000000..d60dd72bd4c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 @@ -0,0 +1,539 @@ +! { dg-additional-options "-cpp" } + +subroutine f1 + !$omp cancel parallel ! { dg-error "orphaned" } + !$omp cancel do ! { dg-error "orphaned" } + !$omp cancel sections ! { dg-error "orphaned" } + !$omp cancel taskgroup ! { dg-error "orphaned" } + !$omp cancellation point parallel ! { dg-error "orphaned" } + !$omp cancellation point do ! { dg-error "orphaned" } + !$omp cancellation point sections ! { dg-error "orphaned" } + !$omp cancellation point taskgroup ! { dg-error "orphaned" } +end + +subroutine f2 + integer :: i, j + j = 0 + !$omp parallel + !$omp cancel parallel + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + + !$omp master + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end master + + !$omp masked + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end masked + + !$omp scope + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end scope + + !$omp single + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end single + + !$omp critical + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end critical + + !$omp taskgroup + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end taskgroup + + !$omp task + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + + !$omp taskgroup + !$omp task + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup + !$omp end task + !$omp end taskgroup + + !$omp taskloop + do i = 0, 9 + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup + !$omp task + !$omp cancellation point taskgroup + !$omp cancel taskgroup + !$omp end task + end do + !$omp taskloop nogroup + do i = 0, 9 + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp task + !$omp cancellation point taskgroup! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + end do + !$omp taskgroup + !$omp task + !$omp task + !$omp cancellation point taskgroup + !$omp cancel taskgroup + !$omp end task + !$omp end task + !$omp taskloop nogroup + do i = 0, 9 + !$omp task + !$omp cancellation point taskgroup + !$omp cancel taskgroup + !$omp end task + !$omp cancellation point taskgroup + !$omp cancel taskgroup + end do + !$omp end taskgroup + + !$omp taskgroup + !$omp parallel + !$omp task + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + !$omp taskloop + do i = 0, 9 + !$omp cancel taskgroup + !$omp cancellation point taskgroup + end do + !$omp taskloop nogroup + do i = 0, 9 + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + end do + !$omp end parallel + !$omp target + !$omp task + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + !$omp end target + !$omp target + !$omp teams + !$omp distribute + do i = 0, 9 + !$omp task + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + end do + !$omp end distribute + !$omp end teams + !$omp end target + !$omp target data map(i) + !$omp task + !$omp cancel taskgroup + !$omp cancellation point taskgroup + !$omp end task + !$omp end target data + !$omp end taskgroup + + !$omp taskloop + do i = 0, 9 + !$omp parallel + !$omp task + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + !$omp end parallel + !$omp target + !$omp task + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + !$omp end target + !$omp target + !$omp teams + !$omp distribute + do j = 0, 9 + !$omp task + !$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" } + !$omp end task + end do + !$omp end distribute + !$omp end teams + !$omp end target + !$omp target data map(i) + !$omp task + !$omp cancel taskgroup + !$omp cancellation point taskgroup + !$omp end task + !$omp end target data + end do + + !$omp do + do i = 0, 9 + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup! { dg-error "not closely nested inside" } + end do + + !$omp do ordered + do i = 0, 9 + !$omp ordered + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup! { dg-error "not closely nested inside" } + !$omp end ordered + end do + !$omp end do + !$omp sections + block + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections + !$omp cancellation point taskgroup! { dg-error "not closely nested inside" } + end block + !$omp section + block + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections + !$omp cancellation point taskgroup! { dg-error "not closely nested inside" } + end block + !$omp target data map(j) + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target data + !$omp target + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target + !$omp end sections + !$omp end parallel + !$omp target data map(j) + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target data + !$omp target + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target + !$omp target teams + !$omp cancel parallel ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancel do ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancel sections ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancel taskgroup ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancellation point parallel ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancellation point do ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancellation point sections ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp cancellation point taskgroup ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" } + !$omp end target teams + !$omp target teams distribute + do i = 0, 9 + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + end do + !$omp end target teams distribute + !$omp do + do i = 0, 9 + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + end do + !$omp do + do i = 0, 9 + !$omp target data map(j) + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target data + end do + !$omp do + do i = 0, 9 + !$omp target + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target + end do + !$omp do ordered + do i = 0, 9 + !$omp ordered + !$omp target data map(j) + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup! { dg-error "not closely nested inside" } + !$omp end target data + !$omp end ordered + end do + do i = 0, 9 + !$omp ordered + !$omp target + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup! { dg-error "not closely nested inside" } + !$omp end target + !$omp end ordered + end do + !$omp sections + block + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + end block + !$omp section + block + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + end block + !$omp end sections + !$omp sections + !$omp target data map(j) + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target data + !$omp section + !$omp target data map(j) + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target data + !$omp end sections + !$omp sections + !$omp target + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target + !$omp section + !$omp target + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end target + !$omp end sections + !$omp task + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup + !$omp taskgroup + !$omp cancel parallel ! { dg-error "not closely nested inside" } + !$omp cancel do ! { dg-error "not closely nested inside" } + !$omp cancel sections ! { dg-error "not closely nested inside" } + !$omp cancel taskgroup ! { dg-error "not closely nested inside" } + !$omp cancellation point parallel ! { dg-error "not closely nested inside" } + !$omp cancellation point do ! { dg-error "not closely nested inside" } + !$omp cancellation point sections ! { dg-error "not closely nested inside" } + !$omp cancellation point taskgroup ! { dg-error "not closely nested inside" } + !$omp end taskgroup + !$omp end task +end + +subroutine f3 + integer i + !$omp do + do i = 0, 9 + !$omp cancel do ! { dg-warning "nowait" } + end do + !$omp end do nowait + !$omp sections + block + !$omp cancel sections ! { dg-warning "nowait" } + end block + !$omp section + block + !$omp cancel sections ! { dg-warning "nowait" } + end block + !$omp end sections nowait + !$omp do ordered + do i = 0, 9 + !$omp cancel do ! { dg-warning "ordered" } + !$omp ordered + !$omp end ordered + end do +end + + +subroutine f4 +! if (.false.) then +!$omp cancellation point do ! { dg-error "orphaned 'cancellation point' construct" } +! end if +end diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 new file mode 100644 index 00000000000..0fb814e42e4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 @@ -0,0 +1,9 @@ +subroutine f4 + !$omp cancellation point ! { dg-error "Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP in .OMP CANCELLATION POINT statement at" } + if (.false.) then +!$omp cancellation EKAHI ! { dg-error "Unclassifiable OpenMP directive" } + end if +!$omp cancellation HO OKAHI ! { dg-error "Unclassifiable OpenMP directive" } + +!$omp cancellation point ! { dg-error "Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP in .OMP CANCELLATION POINT statement at" } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-4.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-4.f90 new file mode 100644 index 00000000000..73745893c69 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/loop-4.f90 @@ -0,0 +1,279 @@ +module m + use iso_c_binding, only: c_loc + implicit none (type, external) + integer :: v + interface + subroutine foo (); end + integer function omp_get_thread_num (); end + integer function omp_get_num_threads (); end + integer function omp_get_cancellation (); end + integer(c_int) function omp_target_is_present(ptr, device_num) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_int + type(c_ptr), value :: ptr + integer(c_int), value :: device_num + end + end interface + +contains +subroutine f1(a) + integer :: a(0:) + integer :: i, j + !$omp simd order(concurrent) + do i = 0, 63 + !$omp loop + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do +end + +subroutine f2 (a) + integer :: a(0:) + integer :: i, j + !$omp do simd order(concurrent) + do i = 0, 63 + !$omp loop + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do +end + +subroutine f3 (a) + integer :: a(0:) + integer :: i, j + !$omp do order(concurrent) + do i = 0, 63 + !$omp loop + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do +end + +subroutine f4 (a) + integer, target :: a(0:) + integer :: i, j + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp parallel + call foo () + !$omp end parallel + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp simd + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp loop + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end critical + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end ordered + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + v = v + 1 + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + a(i) = v + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + !$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + v = a(i) + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop order(concurrent) bind(parallel) + do i = 0, 63 + a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do +end + +subroutine f5 (a) + integer, target :: a(0:) + integer :: i, j + !$omp parallel + !$omp loop + do i = 0, 63 + !$omp parallel + call foo () + !$omp end parallel + end do + !$omp loop + do i = 0, 63 + !$omp simd + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do + !$omp loop + do i = 0, 63 + !$omp loop + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do + !$omp loop + do i = 0, 63 + !$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end critical + end do + !$omp loop + do i = 0, 63 + !$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end ordered + end do + !$omp loop + do i = 0, 63 + !$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + v = v + 1 + end do + !$omp loop + do i = 0, 63 + !$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + a(i) = v + end do + !$omp loop + do i = 0, 63 + !$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + v = a(i) + end do + !$omp loop + do i = 0, 63 + !$omp master ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end master + end do + !$omp loop + do i = 0, 63 + !$omp masked ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end masked + end do + !$omp loop + do i = 0, 63 + !$omp scope ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end scope + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp end parallel +end + +subroutine f6 (a) + integer, target :: a(0:) + integer :: i, j + !$omp master + !$omp loop + do i = 0, 63 + !$omp parallel + call foo () + !$omp end parallel + end do + !$omp loop + do i = 0, 63 + !$omp simd + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do + !$omp loop + do i = 0, 63 + !$omp loop + do j = 0, 63 + a(64 * i + j) = i + j + end do + end do + !$omp loop + do i = 0, 63 + !$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end critical + end do + !$omp loop + do i = 0, 63 + !$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + call foo () + !$omp end ordered + end do + !$omp loop + do i = 0, 63 + !$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + v = v + 1 + end do + !$omp loop + do i = 0, 63 + !$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + a(i) = v + end do + !$omp loop + do i = 0, 63 + !$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" } + v = a(i) + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp loop + do i = 0, 63 + a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" } + end do + !$omp end master +end +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 b/gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 new file mode 100644 index 00000000000..af4c2fbfef3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 @@ -0,0 +1,68 @@ +module m + implicit none + integer i +contains + +subroutine f_omp_parallel + !$omp parallel + !$omp parallel + !$omp end parallel + + !$omp target + !$omp end target + + !$omp target data map(i) + !$omp end target data + + !$omp target update to(i) + + !$omp target data map(i) + !$omp parallel + !$omp end parallel + + !$omp target + !$omp end target + + !$omp target data map(i) + !$omp end target data + + !$omp target update to(i) + !$omp end target data + !$omp end parallel +end + +subroutine f_omp_target + !$omp target + !$omp parallel + !$omp end parallel + !$omp end target +end + +subroutine f_omp_target_data + !$omp target data map(i) + !$omp parallel + !$omp end parallel + + !$omp target + !$omp end target + + !$omp target data map(i) + !$omp end target data + + !$omp target update to(i) + + !$omp target data map(i) + !$omp parallel + !$omp end parallel + + !$omp target + !$omp end target + + !$omp target data map(i) + !$omp end target data + + !$omp target update to(i) + !$omp end target data + !$omp end target data +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 b/gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 new file mode 100644 index 00000000000..2eccdf9b034 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 @@ -0,0 +1,165 @@ +subroutine foo + integer :: i, j + !$omp taskloop + do i = 0, 63 + !$omp do ! { dg-error "region may not be closely nested inside of" } + do j = 0, 9 + end do + !$omp single ! { dg-error "region may not be closely nested inside of" } + !$omp end single + !$omp sections ! { dg-error "region may not be closely nested inside of" } + !$omp section + block + end block + !$omp end sections + !$omp barrier ! { dg-error "region may not be closely nested inside of" } + !$omp master ! { dg-error "region may not be closely nested inside of" } -- ? + block; end block ! otherwise not generated + !$omp end master + !$omp masked ! { dg-error "region may not be closely nested inside of" } -- ? + block; end block ! otherwise not generated + !$omp end masked + !$omp scope ! { dg-error "region may not be closely nested inside of" } -- ? + block; end block ! otherwise not generated + !$omp end scope + !$omp ordered ! { dg-error "region may not be closely nested inside of" } + !$omp end ordered + !$omp ordered threads ! { dg-error "region may not be closely nested inside of" } + !$omp end ordered + !$omp ordered simd threads ! { dg-error ".ordered. .simd. must be closely nested inside .simd. region" } + !$omp end ordered + !$omp simd + do j = 0, 9 + !$omp ordered simd + !$omp end ordered + end do + !$omp critical + !$omp simd + do j = 0, 9 + !$omp ordered simd + !$omp end ordered + end do + !$omp end critical + end do + !$omp taskloop + do i = 0, 63 + !$omp parallel + !$omp do + do j = 0, 9 + end do + !$omp single + !$omp end single + !$omp sections + !$omp section + block; end block + !$omp end sections + !$omp barrier + !$omp master + block; end block ! otherwise not generated + !$omp end master + !$omp masked + block; end block ! otherwise not generated + !$omp end masked + !$omp scope + block; end block ! otherwise not generated + !$omp end scope + !$omp ordered ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" } + !$omp end ordered + !$omp ordered threads ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" } + !$omp end ordered + !$omp simd + do j = 0, 9 + !$omp ordered simd + !$omp end ordered + end do + !$omp critical + !$omp simd + do j = 0, 9 + !$omp ordered simd + !$omp end ordered + end do + !$omp end critical + !$omp end parallel + end do + !$omp taskloop + do i = 0, 63 + !$omp target + !$omp do + do j = 0, 9 + end do + !$omp single + !$omp end single + !$omp sections + !$omp section + block; end block + !$omp end sections + !$omp barrier + !$omp master + block; end block ! otherwise not generated + !$omp end master + !$omp masked + block; end block ! otherwise not generated + !$omp end masked + !$omp scope + block; end block ! otherwise not generated + !$omp end scope + !$omp ordered ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" } + !$omp end ordered + !$omp ordered threads ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" } + !$omp end ordered + !$omp simd + do j = 0, 9 + !$omp ordered simd + !$omp end ordered + end do + !$omp critical + !$omp simd + do j = 0, 9 + !$omp ordered simd + !$omp end ordered + end do + !$omp end critical + !$omp end target + end do + !$omp ordered + !$omp ordered ! { dg-error "region may not be closely nested inside of" } + !$omp end ordered + !$omp end ordered + !$omp ordered threads + !$omp ordered ! { dg-error "region may not be closely nested inside of" } + !$omp end ordered + !$omp end ordered + !$omp ordered + !$omp ordered threads ! { dg-error "region may not be closely nested inside of" } + !$omp end ordered + !$omp end ordered + !$omp ordered threads + !$omp ordered threads ! { dg-error "region may not be closely nested inside of" } + !$omp end ordered + !$omp end ordered + !$omp critical + !$omp ordered simd ! { dg-error ".ordered. .simd. must be closely nested inside .simd. region" } + !$omp end ordered + !$omp end critical + !$omp do ordered + do i = 0, 63 + !$omp parallel + !$omp ordered threads ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" } + !$omp end ordered + !$omp end parallel + end do + !$omp do ordered + do i = 0, 63 + !$omp parallel + !$omp ordered ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" } + !$omp end ordered + !$omp end parallel + end do + !$omp do ordered(1) + do i = 0, 63 + !$omp parallel + !$omp ordered depend(source) ! { dg-error ".ordered. construct with .depend. clause must be closely nested inside a loop with .ordered. clause with a parameter" } + !$omp ordered depend(sink: i - 1) ! { dg-error ".ordered. construct with .depend. clause must be closely nested inside a loop with .ordered. clause with a parameter" } + !$omp end parallel + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 new file mode 100644 index 00000000000..cd2e39ae082 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 @@ -0,0 +1,347 @@ +subroutine f1 + integer i, j + !$omp do + do i = 0, 2 + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp master ! { dg-error "may not be closely nested" } + block; end block + !$omp end master + !$omp masked ! { dg-error "may not be closely nested" } + block; end block + !$omp end masked + !$omp barrier ! { dg-error "may not be closely nested" } + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + end do + !$omp sections + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp end sections + !$omp sections + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp end sections + !$omp sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp end sections + !$omp sections + !$omp master ! { dg-error "may not be closely nested" } + block; end block + !$omp end master + !$omp end sections + !$omp sections + !$omp masked ! { dg-error "may not be closely nested" } + block; end block + !$omp end masked + !$omp end sections + !$omp sections + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end sections + !$omp sections + !$omp section + block; end block + !$omp end sections + !$omp sections + !$omp section + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp end sections + !$omp sections + !$omp section + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp end sections + !$omp sections + !$omp section + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp end sections + !$omp sections + !$omp section + !$omp master ! { dg-error "may not be closely nested" } + block; end block + !$omp end master + !$omp section + !$omp masked ! { dg-error "may not be closely nested" } + block; end block + !$omp end masked + !$omp end sections + !$omp sections + !$omp section + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end sections + !$omp single + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp master ! { dg-error "may not be closely nested" } + block; end block + !$omp end master + !$omp masked ! { dg-error "may not be closely nested" } + block; end block + !$omp end masked + !$omp barrier ! { dg-error "may not be closely nested" } + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end single + !$omp master + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp master + block; end block + !$omp end master + !$omp barrier ! { dg-error "may not be closely nested" } + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end master + !$omp masked filter (1) + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp master + block; end block + !$omp end master + !$omp barrier ! { dg-error "may not be closely nested" } + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end masked + !$omp task + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp master ! { dg-error "may not be closely nested" } + block; end block + !$omp end master + !$omp masked ! { dg-error "may not be closely nested" } + block; end block + !$omp end masked + !$omp barrier ! { dg-error "may not be closely nested" } + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end task + !$omp parallel + !$omp do + do j = 0, 2 + block; end block + end do + !$omp sections + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single + block; end block + !$omp end single + !$omp master + block; end block + !$omp end master + !$omp masked + block; end block + !$omp end masked + !$omp barrier + !$omp scope + block; end block + !$omp end scope + !$omp scope + !$omp scope + block; end block + !$omp end scope + !$omp end scope + !$omp end parallel + !$omp scope + !$omp do + do j = 0, 2 + block; end block + end do + !$omp sections + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single + block; end block + !$omp end single + !$omp master + block; end block + !$omp end master + !$omp masked + block; end block + !$omp end masked + !$omp barrier + !$omp scope + block; end block + !$omp end scope + !$omp scope + !$omp scope + block; end block + !$omp end scope + !$omp end scope + !$omp end scope +end + +subroutine f2 + integer i, j + !$omp ordered + !$omp do ! { dg-error "may not be closely nested" } + do j = 0, 2 + block; end block + end do + !$omp sections ! { dg-error "may not be closely nested" } + block; end block + !$omp section + block; end block + !$omp end sections + !$omp single ! { dg-error "may not be closely nested" } + block; end block + !$omp end single + !$omp master + block; end block + !$omp end master + !$omp masked + block; end block + !$omp end masked + !$omp barrier ! { dg-error "may not be closely nested" } + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end ordered +end + +subroutine f3 (void) + !$omp critical + !$omp ordered ! { dg-error "may not be closely nested" } + block; end block + !$omp end ordered + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end critical +end + +subroutine f4 (void) + !$omp task + !$omp ordered ! { dg-error "may not be closely nested" } + block; end block + !$omp end ordered + !$omp scope ! { dg-error "may not be closely nested" } + block; end block + !$omp end scope + !$omp end task +end + +subroutine f5 (void) + integer i + !$omp do + do i = 0, 9 + !$omp ordered ! { dg-error "must be closely nested" } + block; end block + !$omp end ordered + end do + !$omp do ordered + do i = 0, 9 + !$omp ordered + block; end block + !$omp end ordered + end do +end + +subroutine f6 (void) + !$omp critical (foo) + !$omp critical (bar) + block; end block + !$omp end critical (bar) + !$omp end critical (foo) + !$omp critical + !$omp critical (baz) + block; end block + !$omp end critical (baz) + !$omp end critical +end + +subroutine f7 (void) + !$omp critical (foo2) + !$omp critical + block; end block + !$omp end critical + !$omp end critical (foo2) + !$omp critical (bar) + !$omp critical (bar) ! { dg-error "may not be nested" } + block; end block + !$omp end critical (bar) + !$omp end critical (bar) + !$omp critical + !$omp critical ! { dg-error "may not be nested" } + block; end block + !$omp end critical + !$omp end critical +end diff --git a/gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 b/gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 new file mode 100644 index 00000000000..b47b4a14e86 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 @@ -0,0 +1,19 @@ +subroutine foo + +!$omp do +do i = 1, 2 +end do +!$omp end do nowait foo ! { dg-error "Unexpected junk after NOWAIT clause" } +!$omp end do ! as previous line is ignored + +!$omp scope + block; end block +!$omp end scope bar ! { dg-error "Unexpected junk at" } +!$omp end scope + +!$omp scope + block; end block +!$omp end scope nowait nowait ! { dg-error "Unexpected junk after NOWAIT clause" } +!$omp end scope + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90 new file mode 100644 index 00000000000..99c097f1dad --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90 @@ -0,0 +1,112 @@ +module m + implicit none + integer v + interface + subroutine foo(x) + integer, value :: x + end + end interface +contains + +subroutine bar + integer i + !$omp do reduction (task, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp sections reduction (task, +: v) + call foo (-2) + !$omp section + call foo (-3) + !$omp end sections + !$omp parallel reduction (task, +: v) + call foo (-1) + !$omp end parallel + !$omp parallel do reduction (task, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp end parallel do + !$omp parallel sections reduction (task, +: v) + call foo (-2) + !$omp section + call foo (-3) + !$omp end parallel sections + !$omp teams distribute parallel do reduction (task, +: v) ! { dg-bogus "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" "PR101948" { xfail *-*-* } } + do i = 0, 63 + call foo (i) + end do + !$omp end teams distribute parallel do + !$omp do reduction (default, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp sections reduction (default, +: v) + call foo (-2) + !$omp section + call foo (-3) + !$omp end sections + !$omp parallel reduction (default, +: v) + call foo (-1) + !$omp end parallel + !$omp parallel do reduction (default, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp end parallel do + !$omp parallel sections reduction (default, +: v) + call foo (-2) + !$omp section + call foo (-3) + !$omp end parallel sections + !$omp teams distribute parallel do reduction (default, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp end teams distribute parallel do + !$omp do reduction (default, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp end do nowait + !$omp sections reduction (default, +: v) + call foo (-2) + !$omp section + call foo (-3) + !$omp end sections nowait + !$omp simd reduction (default, +: v) + do i = 0, 63 + v = v + 1 + end do + !$omp do simd reduction (default, +: v) + do i = 0, 63 + v = v + 1 + end do + !$omp parallel do simd reduction (default, +: v) + do i = 0, 63 + v = v + 1 + end do + !$omp end parallel do simd + !$omp teams distribute parallel do simd reduction (default, +: v) + do i = 0, 63 + v = v + 1 + end do + !$omp end teams distribute parallel do simd + !$omp taskloop reduction (default, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp taskloop simd reduction (default, +: v) + do i = 0, 63 + v = v + 1 + end do + !$omp teams reduction (default, +: v) + call foo (i) + !$omp end teams + !$omp teams distribute reduction (default, +: v) + do i = 0, 63 + call foo (i) + end do + !$omp end teams distribute +end +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90 new file mode 100644 index 00000000000..c4169bc55d1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90 @@ -0,0 +1,45 @@ +module m + integer :: v + interface + subroutine foo(i) + integer :: i + end + end interface +end + +subroutine bar + use m + implicit none + integer :: i + !$omp do reduction (task, +: v) ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" } + do i = 0, 63 + call foo (i) + end do + !$omp end do nowait + !$omp sections reduction (task, +: v) ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" } + call foo (-2) + !$omp section + call foo (-3) + !$omp end sections nowait + !$omp scope reduction (task, +: v) ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" } + call foo (-4) + !$omp end scope nowait + !$omp simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" } + do i = 0, 63 + v = v + 1 + end do + !$omp do simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" } + do i = 0, 63 + v = v + 1 + end do + !$omp parallel do simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" } + do i = 0, 63 + v = v + 1 + end do + !$omp end parallel do simd + !$omp teams distribute parallel do simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" } + do i = 0, 63 + v = v + 1 + end do + !$omp end teams distribute parallel do simd +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90 new file mode 100644 index 00000000000..37ce1c8b7b8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90 @@ -0,0 +1,30 @@ +module m + integer :: v + interface + subroutine foo(i) + integer :: i + end + end interface +end + +subroutine bar + use m + implicit none + integer :: i + !$omp taskloop reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + do i = 0, 63 + call foo (i) + end do + !$omp taskloop simd reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + do i = 0, 63 + v = v + 1 + end do + !$omp teams reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + call foo (i) + !$omp end teams + !$omp teams distribute reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + do i = 0, 63 + call foo (i) + end do + !$omp end teams distribute +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90 new file mode 100644 index 00000000000..ebf1f136180 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90 @@ -0,0 +1,15 @@ +! Fortran testcase of reduction-task-3.f90 ( PR c/91149 ) + +module m + integer :: r +end + +subroutine foo + use m + !$omp parallel reduction(task, +: r) + r = r + 1 + !$omp end parallel + !$omp target parallel reduction(task, +: r) + r = r + 1 + !$omp end target parallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 index 61d89259c48..f91c7fae09d 100644 --- a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 @@ -105,6 +105,11 @@ subroutine f3 (c, d) ! ... !$omp end teams + !$omp scope reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + ! ... + !$omp end scope + !$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 diff --git a/gcc/testsuite/gfortran.dg/gomp/scope-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scope-1.f90 new file mode 100644 index 00000000000..43ec8007df7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scope-1.f90 @@ -0,0 +1,39 @@ +module m + implicit none (external, type) + integer :: r, r2, r3 +contains + +subroutine foo + integer :: i, j, k + i = 0; j = 0; k = 0 + !$omp scope private (i) reduction (+:r) + i = 1 + r = r + 1 + !$omp end scope nowait + + !$omp scope private (i) reduction (task, +:r) + !$omp scope private (j) reduction (task, +:r2) + !$omp scope private (k) reduction (task, +:r3) + i = 1 + j = 2 + k = 3 + r = r + 1 + r2 = r2 + 1 + r3 = r3 + 1 + !$omp end scope + !$omp end scope + !$omp end scope + !$omp parallel + !$omp scope reduction (+:r) private (i) + !$omp scope reduction (+:r2) private (j) + !$omp single + i = 1 + j = 2 + r = r + 1 + r2 = r2 + 1 + !$omp end single + !$omp end scope nowait + !$omp end scope nowait + !$omp end parallel +end +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/scope-2.f90 b/gcc/testsuite/gfortran.dg/gomp/scope-2.f90 new file mode 100644 index 00000000000..a097ced86ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scope-2.f90 @@ -0,0 +1,40 @@ +module m + implicit none (type, external) + integer :: r, r2, r3 = 1 + interface + logical function bar(); end + end interface +contains + +subroutine foo + integer :: i, j, k + i = 0; j = 0; k = 0 + !$omp parallel + if (bar ()) then + !$omp cancel parallel + end if + !$omp scope reduction (+:r) private (i) + !$omp scope reduction (+:r2) private (j) + !$omp single + i = 1; + j = 2; + r = r + 1 + r2 = r2 + 1 + !$omp end single nowait + !$omp end scope + !$omp end scope + !$omp end parallel + + !$omp parallel + if (bar ()) then + !$omp cancel parallel + end if + !$omp scope reduction (task, +:r) private (i) + !$omp scope reduction (task, *:r3) + r = r + 1 + r3 = r3 + 1 + !$omp end scope + !$omp end scope + !$omp end parallel +end +end module diff --git a/libgomp/testsuite/libgomp.fortran/scope-1.f90 b/libgomp/testsuite/libgomp.fortran/scope-1.f90 new file mode 100644 index 00000000000..3f41e894131 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/scope-1.f90 @@ -0,0 +1,55 @@ +program main + implicit none (type, external) + integer :: r, r2, i + integer a(0:63) + a = 0 + r = 0; r2 = 0 + !$omp parallel + !$omp scope + !$omp scope + !$omp do + do i = 0, 63 + a(i) = a(i) + 1 + end do + !$omp end do + !$omp end scope nowait + !$omp end scope nowait + + !$omp scope reduction(+: r) + !$omp do + do i = 0, 63 + r = r + i + if (a(i) /= 1) & + stop 1 + end do + !$omp end do nowait + !$omp barrier + !$omp end scope nowait + + !$omp barrier + + if (r /= 64 * 63 / 2) & + stop 2 + + !$omp scope private (i) + !$omp scope reduction(+: r2) + !$omp do + do i = 0, 63 + r2 = r2 + 2 * i + a(i) = a(i) + i + end do + !$omp end do nowait + !$omp end scope + !$omp end scope nowait + + if (r2 /= 64 * 63) & + stop 3 + + !$omp do + do i = 0, 63 + if (a(i) /= i + 1) & + stop 4 + end do + !$omp end do nowait + !$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90 b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90 new file mode 100644 index 00000000000..c6b39e0b391 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90 @@ -0,0 +1,82 @@ +module m + implicit none (external, type) + integer :: a, b(0:2) = [1, 1, 1] + integer(8) :: c(0:1) = [not(0_8), not(0_8)] +contains + subroutine bar (i) + integer :: i + !$omp task in_reduction (*: b) in_reduction (iand: c) & + !$omp& in_reduction (+: a) + a = a + 4 + b(1) = b(1) * 4 + c(1) = iand (c(1), not(ishft(1_8, i + 16))) + !$omp end task + end subroutine bar + + subroutine foo (x) + integer :: x + !$omp scope reduction (task, +: a) + !$omp scope reduction (task, *: b) + !$omp scope reduction (task, iand: c) + !$omp barrier + !$omp sections + block + a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3 + c(1) = iand(c(1), not(ishft(1_8, 2))) + end block + !$omp section + block + b(0) = b(0) * 2; call bar (4); b(2) = b(2) * 3 + c(1) = iand(c(1), not(ishft(1_8, 4))); a = a + 1 + end block + !$omp section + block + call bar (6); b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 6))) + a = a + 1; b(0) = b(0) * 2 + end block + !$omp section + block + b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 8))) + a = a + 1; b(0) = b(0) * 2; call bar (8) + end block + !$omp section + block + c(1) = iand(c(1), not(ishft(1_8, 10))); a = a + 1 + b(0) = b(0) * 2; call bar (10); b(2) = b(2) * 3 + end block + !$omp section + block + a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3 + c(1) = iand(c(1), not(ishft(1_8, 12))); call bar (12) + end block + !$omp section + if (x /= 0) then + a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3 + call bar (14); c(1) = iand (c(1), not(ishft(1_8, 14))) + end if + !$omp end sections + !$omp end scope + !$omp end scope + !$omp end scope + end subroutine foo +end module m + +program main + use m + implicit none (type, external) + integer, volatile :: one + one = 1 + call foo (0) + if (a /= 30 .or. b(0) /= 64 .or. b(1) /= ishft (1, 12) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 & + .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'15541554', kind=8))) & + stop 1 + a = 0 + b(:) = [1, 1, 1] + c(1) = not(0_8) + !$omp parallel + call foo (one) + !$omp end parallel + if (a /= 35 .or. b(0) /= 128 .or. b(1) /= ishft(1, 14) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 * 3 & + .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'55545554', kind=8))) & + stop 2 +end program main