From: Tobias Burnus Date: Tue, 8 Dec 2020 15:49:46 +0000 (+0100) Subject: Fortran: Add 'omp scan' support of OpenMP 5.0 X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=005cff4e2ecbd5c4e2ef978fe4842fa3c8c79f47;p=gcc.git Fortran: Add 'omp scan' support of OpenMP 5.0 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses, show_omp_node, show_code_node): Handle OMP SCAN. * gfortran.h (enum gfc_statement): Add ST_OMP_SCAN. (enum): Add OMP_LIST_SCAN_IN and OMP_LIST_SCAN_EX. (enum gfc_exec_op): Add EXEC_OMP_SCAN. * match.h (gfc_match_omp_scan): New prototype. * openmp.c (gfc_match_omp_scan): New. (gfc_match_omp_taskgroup): Cleanup. (resolve_omp_clauses, gfc_resolve_omp_do_blocks, omp_code_to_statement, gfc_resolve_omp_directive): Handle 'omp scan'. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Handle EXEC_OMP_SCAN. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_do, gfc_split_omp_clauses): Handle 'omp scan'. libgomp/ChangeLog: * testsuite/libgomp.fortran/scan-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/reduction4.f90: Update; move FE some tests to ... * gfortran.dg/gomp/reduction6.f90: ... this new test and ... * gfortran.dg/gomp/reduction7.f90: ... this new test. * gfortran.dg/gomp/reduction5.f90: Add dg-error. * gfortran.dg/gomp/scan-1.f90: New test. * gfortran.dg/gomp/scan-2.f90: New test. * gfortran.dg/gomp/scan-3.f90: New test. * gfortran.dg/gomp/scan-4.f90: New test. * gfortran.dg/gomp/scan-5.f90: New test. * gfortran.dg/gomp/scan-6.f90: New test. * gfortran.dg/gomp/scan-7.f90: New test. --- diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 1012b11fb98..b3fa1785b14 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1600,6 +1600,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; + case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: gcc_unreachable (); } @@ -1803,6 +1805,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break; case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; + case EXEC_OMP_SCAN: name = "SCAN"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; @@ -1873,6 +1876,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: @@ -1933,7 +1937,7 @@ show_omp_node (int level, gfc_code *c) if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA - || c->op == EXEC_OMP_TARGET_EXIT_DATA + || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -3073,6 +3077,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6467985ea7f..41fed15919f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -261,7 +261,7 @@ enum gfc_statement ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, - ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, @@ -1277,6 +1277,8 @@ enum OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM, + OMP_LIST_SCAN_IN, + OMP_LIST_SCAN_EX, OMP_LIST_REDUCTION, OMP_LIST_REDUCTION_INSCAN, OMP_LIST_REDUCTION_TASK, @@ -2697,7 +2699,7 @@ enum gfc_exec_op EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, - EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 4ccb5961d2b..c771448c184 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -176,6 +176,7 @@ match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_sections (void); match gfc_match_omp_parallel_workshare (void); match gfc_match_omp_requires (void); +match gfc_match_omp_scan (void); match gfc_match_omp_sections (void); match gfc_match_omp_simd (void); match gfc_match_omp_single (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 68d0b65ff87..b1f009785e3 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3882,6 +3882,42 @@ error: } +match +gfc_match_omp_scan (void) +{ + bool incl; + gfc_omp_clauses *c = gfc_get_omp_clauses (); + gfc_gobble_whitespace (); + if ((incl = (gfc_match ("inclusive") == MATCH_YES)) + || gfc_match ("exclusive") == MATCH_YES) + { + if (gfc_match_omp_variable_list (" (", &c->lists[incl ? OMP_LIST_SCAN_IN + : OMP_LIST_SCAN_EX], + false) != MATCH_YES) + { + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + } + else + { + gfc_error ("Expected INCLUSIVE or EXCLUSIVE clause at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$OMP SCAN at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + + new_st.op = EXEC_OMP_SCAN; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + match gfc_match_omp_sections (void) { @@ -4296,13 +4332,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_TASK_REDUCTION, true, true) - != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_TASKGROUP; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); } @@ -4628,7 +4658,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", - "TO", "FROM", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, + "TO", "FROM", "INCLUSIVE", "EXCLUSIVE", + "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", @@ -4865,6 +4896,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Object %qs is not a variable at %L", n->sym->name, &n->where); } + if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN] + && code->op != EXEC_OMP_DO + && code->op != EXEC_OMP_SIMD + && code->op != EXEC_OMP_DO_SIMD + && code->op != EXEC_OMP_PARALLEL_DO + && code->op != EXEC_OMP_PARALLEL_DO_SIMD) + gfc_error ("% REDUCTION clause on construct other than DO, SIMD, " + "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L", + &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where); for (list = 0; list < OMP_LIST_NUM; list++) if (list != OMP_LIST_FIRSTPRIVATE @@ -4982,6 +5022,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + bool has_inscan = false, has_notinscan = false; for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) { @@ -5289,6 +5330,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, || list == OMP_LIST_REDUCTION_TASK || list == OMP_LIST_IN_REDUCTION || list == OMP_LIST_TASK_REDUCTION); + if (list == OMP_LIST_REDUCTION_INSCAN) + has_inscan = true; + else if (is_reduction) + has_notinscan = true; + if (has_inscan && has_notinscan && is_reduction) + { + gfc_error ("% and non-% % " + "clauses on the same construct %L", + &n->where); + break; + } if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object %qs in %s clause at %L", n->sym->name, name, &n->where); @@ -6151,6 +6203,28 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) } if (i < omp_current_do_collapse || omp_current_do_collapse <= 0) omp_current_do_collapse = 1; + if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + locus *loc + = &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where; + if (code->ext.omp_clauses->ordered) + gfc_error ("ORDERED clause specified together with % " + "REDUCTION clause at %L", loc); + if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE) + gfc_error ("SCHEDULE clause specified together with % " + "REDUCTION clause at %L", loc); + if (!c->block + || !c->block->next + || !c->block->next->next + || c->block->next->next->op != EXEC_OMP_SCAN + || !c->block->next->next->next + || c->block->next->next->next->next) + gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN " + "between two structured-block-sequences", loc); + else + /* Mark as checked; flag will be unset later. */ + c->block->next->next->ext.omp_clauses->if_present = true; + } } gfc_resolve_blocks (code->block, ns); omp_current_do_collapse = 0; @@ -6534,6 +6608,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DISTRIBUTE_SIMD; case EXEC_OMP_DO_SIMD: return ST_OMP_DO_SIMD; + case EXEC_OMP_SCAN: + return ST_OMP_SCAN; case EXEC_OMP_SIMD: return ST_OMP_SIMD; case EXEC_OMP_TARGET: @@ -6972,7 +7048,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) of each directive. */ void -gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) +gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) { resolve_omp_directive_inside_oacc_region (code); @@ -7046,6 +7122,14 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) gfc_error ("OMP CRITICAL at %L with HINT clause requires a NAME, " "except when omp_sync_hint_none is used", &code->loc); break; + case EXEC_OMP_SCAN: + /* Flag is only used to checking, hence, it is unset afterwards. */ + if (!code->ext.omp_clauses->if_present) + gfc_error ("Unexpected !$OMP SCAN at %L outside loop construct with " + "% REDUCTION clause", &code->loc); + code->ext.omp_clauses->if_present = false; + resolve_omp_clauses (code, code->ext.omp_clauses, ns); + break; default: break; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ec7abc240d6..fe0fffd0d1a 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -999,6 +999,7 @@ decode_omp_directive (void) matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES); break; case 's': + matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN); matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION); matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); @@ -1590,7 +1591,7 @@ next_statement (void) case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ - case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ case ST_END_TEAM: case ST_SYNC_TEAM: \ @@ -2447,6 +2448,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_REQUIRES: p = "!$OMP REQUIRES"; break; + case ST_OMP_SCAN: + p = "!$OMP SCAN"; + break; case ST_OMP_SECTIONS: p = "!$OMP SECTIONS"; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0a8f90775ab..327dffbebf2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12184,6 +12184,7 @@ start: case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index a3b0f12b171..d5bccb80f03 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -231,6 +231,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 6b4ad6a7050..ae290648b99 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2334,6 +2334,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_NONTEMPORAL: clause_code = OMP_CLAUSE_NONTEMPORAL; goto add_clause; + case OMP_LIST_SCAN_IN: + clause_code = OMP_CLAUSE_INCLUSIVE; + goto add_clause; + case OMP_LIST_SCAN_EX: + clause_code = OMP_CLAUSE_EXCLUSIVE; + goto add_clause; add_clause: omp_clauses @@ -4707,7 +4713,31 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, code->exit_label = NULL_TREE; /* Main loop body. */ - tmp = gfc_trans_omp_code (code->block->next, true); + if (clauses->lists[OMP_LIST_REDUCTION_INSCAN]) + { + gcc_assert (code->block->next->next->op == EXEC_OMP_SCAN); + gcc_assert (code->block->next->next->next->next == NULL); + locus *cloc = &code->block->next->next->loc; + location_t loc = gfc_get_location (cloc); + + gfc_code code2 = *code->block->next; + code2.next = NULL; + tmp = gfc_trans_code (&code2); + tmp = build2 (OMP_SCAN, void_type_node, tmp, NULL_TREE); + SET_EXPR_LOCATION (tmp, loc); + gfc_add_expr_to_block (&body, tmp); + input_location = loc; + tree c = gfc_trans_omp_clauses (&body, + code->block->next->next->ext.omp_clauses, + *cloc); + code2 = *code->block->next->next->next; + code2.next = NULL; + tmp = gfc_trans_code (&code2); + tmp = build2 (OMP_SCAN, void_type_node, tmp, c); + SET_EXPR_LOCATION (tmp, loc); + } + else + tmp = gfc_trans_omp_code (code->block->next, true); gfc_add_expr_to_block (&body, tmp); /* Label for cycle statements (if needed). */ @@ -5234,13 +5264,15 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; /* Reduction is allowed on simd, do, parallel and teams. Duplicate it on all of them, but omit on do if - parallel is present. */ + parallel is present; additionally, inscan applies to do/simd only. */ for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++) { - if (mask & GFC_OMP_MASK_TEAMS) + if (mask & GFC_OMP_MASK_TEAMS + && i != OMP_LIST_REDUCTION_INSCAN) clausesa[GFC_OMP_SPLIT_TEAMS].lists[i] = code->ext.omp_clauses->lists[i]; - if (mask & GFC_OMP_MASK_PARALLEL) + if (mask & GFC_OMP_MASK_PARALLEL + && i != OMP_LIST_REDUCTION_INSCAN) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] = code->ext.omp_clauses->lists[i]; else if (mask & GFC_OMP_MASK_DO) diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction4.f90 index af8c91b2a87..812be323b2e 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 df915f1cad4..bfb847e9933 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 00000000000..6bf685130ab --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } + +implicit none +integer :: a, b, i +a = 0 + +!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } +do i=1,10 + a = a + 1 +end do + +!$omp parallel +!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } +do i=1,10 + a = a + 1 +end do +!$omp end parallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 new file mode 100644 index 00000000000..7dc50e1ac69 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/reduction7.f90 @@ -0,0 +1,9 @@ +implicit none +integer :: a, b, i +a = 0 + +!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" } +do i=1,10 + a = a + 1 +end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 new file mode 100644 index 00000000000..8c879fd98b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 @@ -0,0 +1,213 @@ +module m + integer a, b +end module m + +subroutine f1 + use m + !$omp scan inclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } + !$omp scan exclusive (b) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } +end + +subroutine f2 (c, d, e, f) + use m + implicit none + integer i, l, c(*), d(*), e(64), f(64) + l = 1 + + !$omp do reduction (inscan, +: a) reduction (+: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } + do i = 1, 64 + block + b = b + 1 + a = a + c(i) + end block + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (+: a) reduction (inscan, +: b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" } + do i = 1, 64 + block + a = a + 1 + b = b + c(i) + end block + !$omp scan inclusive (b) + d(i) = b + end do + + !$omp do reduction (inscan, +: e) + do i = 1, 64 + block + e(1) = e(1) + c(i) + e(2) = e(2) + c(i) + end block + !$omp scan inclusive (a, e) + block + d(1) = e(1) + f(2) = e(2) + end block + end do + + !$omp do reduction (inscan, +: e(:2)) ! { dg-error "Syntax error in OpenMP variable list" } + do i = 1, 64 + block + e(1) = e(1) + c(i) + e(2) = e(2) + c(i) + end block + !$omp scan inclusive (a, e) ! { dg-error "outside loop construct with 'inscan' REDUCTION clause" } + block + d(1) = e(1) + f(2) = e(2) + end block + end do + + !$omp do reduction (inscan, +: a) ordered ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) ordered(1) ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(static) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(static, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do + + !$omp do reduction (inscan, +: a) schedule(nonmonotonic: dynamic, 2) ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" } + do i = 1, 64 + a = a + c(i) + !$omp scan inclusive (a) + d(i) = a + end do +end + +subroutine f3 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp teams reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause at" } + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + ! ... + !$omp end teams + + !$omp target parallel do reduction (inscan, +: a) map (c, d) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + !$omp teams + !$omp distribute parallel do reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do + !$omp end teams + + !$omp distribute parallel do simd reduction (inscan, +: a) + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f4 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp taskloop reduction (inscan, +: a) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } + ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f7 + use m + implicit none + integer i + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + if (i == 23) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 } + cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } } + elseif (i == 27) then + goto 123 ! Diagnostic by ME, see scan-7.f90 + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + endif + !$omp scan exclusive (a) + block +123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + if (i == 33) then ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 } + cycle ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } } + end if + end block + end do +end + +subroutine f8 (c, d, e, f) + use m + implicit none + integer i, c(64), d(64), e(64), f(64) + !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + block + a = a + c(i) + b = b + d(i) + end block + !$omp scan inclusive (a) inclusive (b) ! { dg-error "Unexpected junk after ..OMP SCAN" } + block + e(i) = a + f(i) = b + end block + end do + + !$omp do reduction (inscan, +: a, b) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + block + a = a + c(i) + b = b + d(i) + end block + !$omp scan ! { dg-error "Expected INCLUSIVE or EXCLUSIVE clause" } + block + e(i) = a + f(i) = b + end block + end do +end + +subroutine f9 + use m + implicit none + integer i +! The first error (exit) causes two follow-up errors: + !$omp simd reduction (inscan, +: a) ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" } + do i = 1, 64 + if (i == 23) & + exit ! { dg-error "EXIT statement at .1. terminating ..OMP DO loop" } */ + !$omp scan exclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" } + a = a + 1 + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 new file mode 100644 index 00000000000..c0572321e51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-2.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer :: a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer i, c(*), d(*) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 new file mode 100644 index 00000000000..83181666462 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-3.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer :: a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer i, c(*), d(*) + !$omp do reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan inclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 new file mode 100644 index 00000000000..c9e9d7e57c9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-4.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module m + integer a, b +end module m + +subroutine f1 (c, d) + use m + implicit none + integer c(*), d(*), i + !$omp do simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan exclusive\\(a\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 new file mode 100644 index 00000000000..a3789a5868a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-5.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +integer function foo(a,b, n) result(r) + implicit none + integer :: a(n), b(n), n, i + r = 0 + !$omp parallel do reduction (inscan, +:r) default(none) firstprivate (a, b) + do i = 1, n + r = r + a(i) + !$omp scan inclusive (r) + b(i) = r + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp parallel firstprivate\\(a\\) firstprivate\\(b\\) default\\(none\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:r\\) nowait" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp scan inclusive\\(r\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 new file mode 100644 index 00000000000..35d5869ac1c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-6.f90 @@ -0,0 +1,16 @@ +module m + integer a, b +end module m + +subroutine f3 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp parallel reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + ! ... + !$omp end parallel + !$omp sections reduction (inscan, +: a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } + !$omp section + ! ... + !$omp end sections +end diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 new file mode 100644 index 00000000000..0446c5eee2b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/scan-7.f90 @@ -0,0 +1,60 @@ +module m + integer a, b +end module m + +subroutine f2 (c, d, e, f) + use m + implicit none + integer i, l, c(*), d(*), e(64), f(64) + l = 1 + + !$omp do reduction (inscan, +: a) linear (l) ! { dg-error "'inscan' 'reduction' clause used together with 'linear' clause for a variable other than loop iterator" } + do i = 1, 64 + block + a = a + c(i) + l = l + 1 + end block + !$omp scan inclusive (a) + d(i) = a + end do +end + +subroutine f5 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a, b) ! { dg-error "'b' specified in 'exclusive' clause but not in 'inscan' 'reduction' clause on the containing construct" } + a = a + c(i) + end do +end + +subroutine f6 (c, d) + use m + implicit none + integer i, c(64), d(64) + !$omp simd reduction (inscan, +: a, b) ! { dg-error "'b' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" } + do i = 1, 64 + d(i) = a + !$omp scan exclusive (a) + a = a + c(i) + end do +end + +subroutine f7 + use m + implicit none + integer i + !$omp simd reduction (inscan, +: a) + do i = 1, 64 + if (i == 27) goto 123 ! { dg-error "invalid branch to/from OpenMP structured block" } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + !$omp scan exclusive (a) + block +123 a = 0 ! { dg-error "jump to label 'l1'" "" { target c++ } } + ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + end block + end do +end diff --git a/libgomp/testsuite/libgomp.fortran/scan-1.f90 b/libgomp/testsuite/libgomp.fortran/scan-1.f90 new file mode 100644 index 00000000000..a6f8ef7ea76 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/scan-1.f90 @@ -0,0 +1,115 @@ +! { dg-require-effective-target size32plus } + +module m + implicit none + integer r, a(1024), b(1024) +contains +subroutine foo (a, b) + integer, contiguous :: a(:), b(:) + integer :: i + !$omp do reduction (inscan, +:r) + do i = 1, 1024 + r = r + a(i) + !$omp scan inclusive(r) + b(i) = r + end do +end + +integer function bar () + integer s, i + s = 0 + !$omp parallel + !$omp do reduction (inscan, +:s) + do i = 1, 1024 + s = s + 2 * a(i) + !$omp scan inclusive(s) + b(i) = s + end do + !$omp end parallel + bar = s +end + +subroutine baz (a, b) + integer, contiguous :: a(:), b(:) + integer :: i + !$omp parallel do reduction (inscan, +:r) + do i = 1, 1024 + r = r + a(i) + !$omp scan inclusive(r) + b(i) = r + end do +end + +integer function qux () + integer s, i + s = 0 + !$omp parallel do reduction (inscan, +:s) + do i = 1, 1024 + s = s + 2 * a(i) + !$omp scan inclusive(s) + b(i) = s + end do + qux = s +end +end module m + +program main + use m + implicit none + + integer s, i + s = 0 + do i = 1, 1024 + a(i) = i-1 + b(i) = -1 + end do + + !$omp parallel + call foo (a, b) + !$omp end parallel + if (r /= 1024 * 1023 / 2) & + stop 1 + do i = 1, 1024 + s = s + i-1 + if (b(i) /= s) then + stop 2 + else + b(i) = 25 + endif + end do + + if (bar () /= 1024 * 1023) & + stop 3 + s = 0 + do i = 1, 1024 + s = s + 2 * (i-1) + if (b(i) /= s) then + stop 4 + else + b(i) = -1 + end if + end do + + r = 0 + call baz (a, b) + if (r /= 1024 * 1023 / 2) & + stop 5 + s = 0 + do i = 1, 1024 + s = s + i-1 + if (b(i) /= s) then + stop 6 + else + b(i) = -25 + endif + end do + + if (qux () /= 1024 * 1023) & + stop 6 + s = 0 + do i = 1, 1024 + s = s + 2 * (i-1) + if (b(i) /= s) & + stop 7 + end do +end program