diff options
Diffstat (limited to 'gcc')
23 files changed, 1774 insertions, 6 deletions
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 53c49fe..92d9f9e 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 5fde417..a7d82ae 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 dce6503..aac16a8 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 1bce43c..9675b65 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) @@ -4488,6 +4490,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) { return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES); @@ -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 e1d78de..24cc9bf 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 8eb8a9a..117062b 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 f61f88a..7d87709 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 623c21f..e0a0014 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -6265,6 +6265,24 @@ gfc_trans_omp_parallel_workshare (gfc_code *code) } 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) { stmtblock_t block, body; @@ -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 ce5b2f8..80b724d0 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 0000000..d60dd72 --- /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 0000000..0fb814e --- /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 0000000..7374589 --- /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 0000000..af4c2fbf --- /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 0000000..2eccdf9 --- /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 0000000..cd2e39a --- /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 0000000..b47b4a1 --- /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 0000000..99c097f --- /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 0000000..c4169bc --- /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 0000000..37ce1c8 --- /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 0000000..ebf1f13 --- /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 61d8925..f91c7fa 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 0000000..43ec800 --- /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 0000000..a097ced --- /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 |