diff options
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/dump-parse-tree.c | 7 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 6 | ||||
-rw-r--r-- | gcc/fortran/match.h | 1 | ||||
-rw-r--r-- | gcc/fortran/openmp.c | 102 | ||||
-rw-r--r-- | gcc/fortran/parse.c | 6 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 1 | ||||
-rw-r--r-- | gcc/fortran/st.c | 1 | ||||
-rw-r--r-- | gcc/fortran/trans-openmp.c | 40 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/reduction4.f90 | 25 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 8 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/reduction6.f90 | 18 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/reduction7.f90 | 9 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-1.f90 | 213 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-2.f90 | 21 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-3.f90 | 21 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-4.f90 | 22 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-5.f90 | 18 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-6.f90 | 16 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/scan-7.f90 | 60 |
19 files changed, 554 insertions, 41 deletions
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 1012b11..b3fa178 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1600,6 +1600,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; + case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: gcc_unreachable (); } @@ -1803,6 +1805,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break; case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; + case EXEC_OMP_SCAN: name = "SCAN"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; @@ -1873,6 +1876,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: @@ -1933,7 +1937,7 @@ show_omp_node (int level, gfc_code *c) if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA - || c->op == EXEC_OMP_TARGET_EXIT_DATA + || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -3073,6 +3077,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6467985..41fed15 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -261,7 +261,7 @@ enum gfc_statement ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, - ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, @@ -1277,6 +1277,8 @@ enum OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM, + OMP_LIST_SCAN_IN, + OMP_LIST_SCAN_EX, OMP_LIST_REDUCTION, OMP_LIST_REDUCTION_INSCAN, OMP_LIST_REDUCTION_TASK, @@ -2697,7 +2699,7 @@ enum gfc_exec_op EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, - EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 4ccb596..c771448 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -176,6 +176,7 @@ match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_sections (void); match gfc_match_omp_parallel_workshare (void); match gfc_match_omp_requires (void); +match gfc_match_omp_scan (void); match gfc_match_omp_sections (void); match gfc_match_omp_simd (void); match gfc_match_omp_single (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 68d0b65..b1f0097 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3883,6 +3883,42 @@ error: match +gfc_match_omp_scan (void) +{ + bool incl; + gfc_omp_clauses *c = gfc_get_omp_clauses (); + gfc_gobble_whitespace (); + if ((incl = (gfc_match ("inclusive") == MATCH_YES)) + || gfc_match ("exclusive") == MATCH_YES) + { + if (gfc_match_omp_variable_list (" (", &c->lists[incl ? OMP_LIST_SCAN_IN + : OMP_LIST_SCAN_EX], + false) != MATCH_YES) + { + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + } + else + { + gfc_error ("Expected INCLUSIVE or EXCLUSIVE clause at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$OMP SCAN at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + + new_st.op = EXEC_OMP_SCAN; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match gfc_match_omp_sections (void) { return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES); @@ -4296,13 +4332,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_TASK_REDUCTION, true, true) - != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_TASKGROUP; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); } @@ -4628,7 +4658,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", - "TO", "FROM", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, + "TO", "FROM", "INCLUSIVE", "EXCLUSIVE", + "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", @@ -4865,6 +4896,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Object %qs is not a variable at %L", n->sym->name, &n->where); } + if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN] + && code->op != EXEC_OMP_DO + && code->op != EXEC_OMP_SIMD + && code->op != EXEC_OMP_DO_SIMD + && code->op != EXEC_OMP_PARALLEL_DO + && code->op != EXEC_OMP_PARALLEL_DO_SIMD) + gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, SIMD, " + "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L", + &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where); for (list = 0; list < OMP_LIST_NUM; list++) if (list != OMP_LIST_FIRSTPRIVATE @@ -4982,6 +5022,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + bool has_inscan = false, has_notinscan = false; for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) { @@ -5289,6 +5330,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, || list == OMP_LIST_REDUCTION_TASK || list == OMP_LIST_IN_REDUCTION || list == OMP_LIST_TASK_REDUCTION); + if (list == OMP_LIST_REDUCTION_INSCAN) + has_inscan = true; + else if (is_reduction) + has_notinscan = true; + if (has_inscan && has_notinscan && is_reduction) + { + gfc_error ("%<inscan%> and non-%<inscan%> %<reduction%> " + "clauses on the same construct %L", + &n->where); + break; + } if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object %qs in %s clause at %L", n->sym->name, name, &n->where); @@ -6151,6 +6203,28 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) } if (i < omp_current_do_collapse || omp_current_do_collapse <= 0) omp_current_do_collapse = 1; + if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + locus *loc + = &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where; + if (code->ext.omp_clauses->ordered) + gfc_error ("ORDERED clause specified together with %<inscan%> " + "REDUCTION clause at %L", loc); + if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE) + gfc_error ("SCHEDULE clause specified together with %<inscan%> " + "REDUCTION clause at %L", loc); + if (!c->block + || !c->block->next + || !c->block->next->next + || c->block->next->next->op != EXEC_OMP_SCAN + || !c->block->next->next->next + || c->block->next->next->next->next) + gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN " + "between two structured-block-sequences", loc); + else + /* Mark as checked; flag will be unset later. */ + c->block->next->next->ext.omp_clauses->if_present = true; + } } gfc_resolve_blocks (code->block, ns); omp_current_do_collapse = 0; @@ -6534,6 +6608,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DISTRIBUTE_SIMD; case EXEC_OMP_DO_SIMD: return ST_OMP_DO_SIMD; + case EXEC_OMP_SCAN: + return ST_OMP_SCAN; case EXEC_OMP_SIMD: return ST_OMP_SIMD; case EXEC_OMP_TARGET: @@ -6972,7 +7048,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) of each directive. */ void -gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) +gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) { resolve_omp_directive_inside_oacc_region (code); @@ -7046,6 +7122,14 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) gfc_error ("OMP CRITICAL at %L with HINT clause requires a NAME, " "except when omp_sync_hint_none is used", &code->loc); break; + case EXEC_OMP_SCAN: + /* Flag is only used to checking, hence, it is unset afterwards. */ + if (!code->ext.omp_clauses->if_present) + gfc_error ("Unexpected !$OMP SCAN at %L outside loop construct with " + "%<inscan%> REDUCTION clause", &code->loc); + code->ext.omp_clauses->if_present = false; + resolve_omp_clauses (code, code->ext.omp_clauses, ns); + break; default: break; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ec7abc2..fe0fffd 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -999,6 +999,7 @@ decode_omp_directive (void) matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES); break; case 's': + matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN); matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION); matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); @@ -1590,7 +1591,7 @@ next_statement (void) case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ - case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ case ST_END_TEAM: case ST_SYNC_TEAM: \ @@ -2447,6 +2448,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_REQUIRES: p = "!$OMP REQUIRES"; break; + case ST_OMP_SCAN: + p = "!$OMP SCAN"; + break; case ST_OMP_SECTIONS: p = "!$OMP SECTIONS"; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0a8f907..327dffb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12184,6 +12184,7 @@ start: case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index a3b0f12..d5bccb8 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -231,6 +231,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 6b4ad6a..ae29064 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2334,6 +2334,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_NONTEMPORAL: clause_code = OMP_CLAUSE_NONTEMPORAL; goto add_clause; + case OMP_LIST_SCAN_IN: + clause_code = OMP_CLAUSE_INCLUSIVE; + goto add_clause; + case OMP_LIST_SCAN_EX: + clause_code = OMP_CLAUSE_EXCLUSIVE; + goto add_clause; add_clause: omp_clauses @@ -4707,7 +4713,31 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, code->exit_label = NULL_TREE; /* Main loop body. */ - tmp = gfc_trans_omp_code (code->block->next, true); + if (clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + gcc_assert (code->block->next->next->op == EXEC_OMP_SCAN); + gcc_assert (code->block->next->next->next->next == NULL); + locus *cloc = &code->block->next->next->loc; + location_t loc = gfc_get_location (cloc); + + gfc_code code2 = *code->block->next; + code2.next = NULL; + tmp = gfc_trans_code (&code2); + tmp = build2 (OMP_SCAN, void_type_node, tmp, NULL_TREE); + SET_EXPR_LOCATION (tmp, loc); + gfc_add_expr_to_block (&body, tmp); + input_location = loc; + tree c = gfc_trans_omp_clauses (&body, + code->block->next->next->ext.omp_clauses, + *cloc); + code2 = *code->block->next->next->next; + code2.next = NULL; + tmp = gfc_trans_code (&code2); + tmp = build2 (OMP_SCAN, void_type_node, tmp, c); + SET_EXPR_LOCATION (tmp, loc); + } + else + tmp = gfc_trans_omp_code (code->block->next, true); gfc_add_expr_to_block (&body, tmp); /* Label for cycle statements (if needed). */ @@ -5234,13 +5264,15 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; /* Reduction is allowed on simd, do, parallel and teams. Duplicate it on all of them, but omit on do if - parallel is present. */ + parallel is present; additionally, inscan applies to do/simd only. */ for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++) { - if (mask & GFC_OMP_MASK_TEAMS) + if (mask & GFC_OMP_MASK_TEAMS + && i != OMP_LIST_REDUCTION_INSCAN) clausesa[GFC_OMP_SPLIT_TEAMS].lists[i] = code->ext.omp_clauses->lists[i]; - if (mask & GFC_OMP_MASK_PARALLEL) + if (mask & GFC_OMP_MASK_PARALLEL + && i != OMP_LIST_REDUCTION_INSCAN) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] = code->ext.omp_clauses->lists[i]; else if (mask & GFC_OMP_MASK_DO) diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 index af8c91b..812be32 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 @@ -28,7 +28,7 @@ do i=1,10 end do !$omp end parallel -!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'parallel' construct" } +!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } do i=1,10 a = a + 1 end do @@ -45,16 +45,6 @@ do i=1,10 a = a + 1 end do -!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" } -do i=1,10 - a = a + 1 -end do - -!$omp simd reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause but not in 'scan' directive clause" } -do i=1,10 - a = a + 1 -end do - ! ------------ do ------------ !$omp parallel !$omp do reduction(+:a) @@ -77,13 +67,6 @@ do i=1,10 end do !$omp end parallel -!$omp parallel -!$omp do reduction(inscan,+:a) ! { dg-error "'a' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" } -do i=1,10 - a = a + 1 -end do -!$omp end parallel - ! ------------ section ------------ !$omp parallel !$omp sections reduction(+:a) @@ -107,7 +90,7 @@ end do !$omp end parallel !$omp parallel -!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'sections' construct" } +!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } !$omp section a = a + 1 !$omp end sections @@ -152,9 +135,8 @@ end do end ! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(\\\+:a\\)" 2 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(task,\\\+:a\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 8 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 7 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(\\\+:a\\)" 2 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(task,\\\+:a\\)" 1 "original" } } @@ -163,7 +145,6 @@ end ! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(task,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(\\\+:a\\)" 2 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(task,\\\+:a\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp target in_reduction\\(\\\+:b\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp task in_reduction\\(\\\+:a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 index df915f1..bfb847e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 @@ -20,7 +20,10 @@ end do a = a + 1 !$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" } -!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "34: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 } + ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-2 } + ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" "" { target *-*-* } .-3 } do i=1,10 a = a + 1 end do @@ -30,7 +33,8 @@ do i=1,10 a = a + 1 end do -!$omp teams reduction(inscan,+:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +!$omp teams reduction(inscan,+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-1 } a = a + 1 !$omp end teams diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 new file mode 100644 index 0000000..6bf6851 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } + +implicit none +integer :: a, b, i +a = 0 + +!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } +do i=1,10 + a = a + 1 +end do + +!$omp parallel +!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } +do i=1,10 + a = a + 1 +end do +!$omp end parallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 new file mode 100644 index 0000000..7dc50e1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 @@ -0,0 +1,9 @@ +implicit none +integer :: a, b, i +a = 0 + +!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" } +do i=1,10 + a = a + 1 +end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 new file mode 100644 index 0000000..8c879fd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 @@ -0,0 +1,213 @@ +module m + integer a, b +end module m + +subroutine f1 + use m + !$omp scan inclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } + !$omp scan exclusive (b) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } +end + +subroutine f2 (c, d, e, f) + use m + implicit none + integer i, l, c(*), d(*), e(64), f(64) + l = 1 + + !$omp do reduction (inscan, +: a) reduction (+: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } + do i = 1, 64 + block + b = b + 1 + a = a + c(i) + end block + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (+: a) reduction (inscan, +: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } + do i = 1, 64 + block + a = a + 1 + b = b + c(i) + end block + !$omp scan inclusive (b) + d(i) = b + end do + + !$omp do reduction (inscan, +: e) + do i = 1, 64 + block + e(1) = e(1) + c(i) + e(2) = e(2) + c(i) + end block + !$omp scan inclusive (a, e) + block + d(1) = e(1) + f(2) = e(2) + end block + end do + + !$omp do reduction (inscan, +: e(:2)) ! { dg-error "Syntax error in OpenMP variable list" } + do i = 1, 64 + block + e(1) = e(1) + c(i) + e(2) = e(2) + c(i) + end block + !$omp scan inclusive (a, e) ! { dg-error "outside loop construct with 'inscan' REDUCTION clause" } + block + d(1) = e(1) + f(2) = e(2) + end block + end do + + !$omp do reduction (inscan, +: a) ordered ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) ordered(1) ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(static) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(static, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(nonmonotonic: dynamic, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do +end + +subroutine f3 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp teams reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause at" } + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + ! ... + !$omp end teams + + !$omp target parallel do reduction (inscan, +: a) map (c, d) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + !$omp teams + !$omp distribute parallel do reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + !$omp end teams + + !$omp distribute parallel do simd reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f4 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp taskloop reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f7 + use m + implicit none + integer i + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + if (i == 23) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 } + cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } } + elseif (i == 27) then + goto 123 ! Diagnostic by ME, see scan-7.f90 + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + endif + !$omp scan exclusive (a) + block +123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + if (i == 33) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 } + cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } } + end if + end block + end do +end + +subroutine f8 (c, d, e, f) + use m + implicit none + integer i, c(64), d(64), e(64), f(64) + !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + block + a = a + c(i) + b = b + d(i) + end block + !$omp scan inclusive (a) inclusive (b) ! { dg-error "Unexpected junk after ..OMP SCAN" } + block + e(i) = a + f(i) = b + end block + end do + + !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + block + a = a + c(i) + b = b + d(i) + end block + !$omp scan ! { dg-error "Expected INCLUSIVE or EXCLUSIVE clause" } + block + e(i) = a + f(i) = b + end block + end do +end + +subroutine f9 + use m + implicit none + integer i +! The first error (exit) causes two follow-up errors: + !$omp simd reduction (inscan, +: a) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + if (i == 23) & + exit ! { dg-error "EXIT statement at .1. terminating ..OMP DO loop" } */ + !$omp scan exclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } + a = a + 1 + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 new file mode 100644 index 0000000..c057232 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer :: a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer i, c(*), d(*) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 new file mode 100644 index 0000000..8318166 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer :: a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer i, c(*), d(*) + !$omp do reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan inclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 new file mode 100644 index 0000000..c9e9d7e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer c(*), d(*), i + !$omp do simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 new file mode 100644 index 0000000..a3789a5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +integer function foo(a,b, n) result(r) + implicit none + integer :: a(n), b(n), n, i + r = 0 + !$omp parallel do reduction (inscan, +:r) default(none) firstprivate (a, b) + do i = 1, n + r = r + a(i) + !$omp scan inclusive (r) + b(i) = r + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp parallel firstprivate\\(a\\) firstprivate\\(b\\) default\\(none\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:r\\) nowait" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(r\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 new file mode 100644 index 0000000..35d5869 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 @@ -0,0 +1,16 @@ +module m + integer a, b +end module m + +subroutine f3 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp parallel reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! ... + !$omp end parallel + !$omp sections reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + !$omp section + ! ... + !$omp end sections +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 new file mode 100644 index 0000000..0446c5e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 @@ -0,0 +1,60 @@ +module m + integer a, b +end module m + +subroutine f2 (c, d, e, f) + use m + implicit none + integer i, l, c(*), d(*), e(64), f(64) + l = 1 + + !$omp do reduction (inscan, +: a) linear (l) ! { dg-error "'inscan' 'reduction' clause used together with 'linear' clause for a variable other than loop iterator" } + do i = 1, 64 + block + a = a + c(i) + l = l + 1 + end block + !$omp scan inclusive (a) + d(i) = a + end do +end + +subroutine f5 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a, b) ! { dg-error "'b' specified in 'exclusive' clause but not in 'inscan' 'reduction' clause on the containing construct" } + a = a + c(i) + end do +end + +subroutine f6 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp simd reduction (inscan, +: a, b) ! { dg-error "'b' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f7 + use m + implicit none + integer i + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + if (i == 27) goto 123 ! { dg-error "invalid branch to/from OpenMP structured block" } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + !$omp scan exclusive (a) + block +123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + end block + end do +end |