Fortran: Add 'omp scan' support of OpenMP 5.0
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_clauses, show_omp_node,
show_code_node): Handle OMP SCAN.
* gfortran.h (enum gfc_statement): Add ST_OMP_SCAN.
(enum): Add OMP_LIST_SCAN_IN and OMP_LIST_SCAN_EX.
(enum gfc_exec_op): Add EXEC_OMP_SCAN.
* match.h (gfc_match_omp_scan): New prototype.
* openmp.c (gfc_match_omp_scan): New.
(gfc_match_omp_taskgroup): Cleanup.
(resolve_omp_clauses, gfc_resolve_omp_do_blocks,
omp_code_to_statement, gfc_resolve_omp_directive): Handle 'omp scan'.
* parse.c (decode_omp_directive, next_statement,
gfc_ascii_statement): Likewise.
* resolve.c (gfc_resolve_code): Handle EXEC_OMP_SCAN.
* st.c (gfc_free_statement): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_do,
gfc_split_omp_clauses): Handle 'omp scan'.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/scan-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/reduction4.f90: Update; move FE some tests to ...
* gfortran.dg/gomp/reduction6.f90: ... this new test and ...
* gfortran.dg/gomp/reduction7.f90: ... this new test.
* gfortran.dg/gomp/reduction5.f90: Add dg-error.
* gfortran.dg/gomp/scan-1.f90: New test.
* gfortran.dg/gomp/scan-2.f90: New test.
* gfortran.dg/gomp/scan-3.f90: New test.
* gfortran.dg/gomp/scan-4.f90: New test.
* gfortran.dg/gomp/scan-5.f90: New test.
* gfortran.dg/gomp/scan-6.f90: New test.
* gfortran.dg/gomp/scan-7.f90: New test.
gcc/fortran/dump-parse-tree.c | 7 +-
gcc/fortran/gfortran.h | 6 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 102 ++++++++++--
gcc/fortran/parse.c | 6 +-
gcc/fortran/resolve.c | 1 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 40 ++++-
gcc/testsuite/gfortran.dg/gomp/reduction4.f90 | 29 +---
gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 7 +-
gcc/testsuite/gfortran.dg/gomp/reduction6.f90 | 18 +++
gcc/testsuite/gfortran.dg/gomp/reduction7.f90 | 9 ++
gcc/testsuite/gfortran.dg/gomp/scan-1.f90 | 213 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/scan-2.f90 | 21 +++
gcc/testsuite/gfortran.dg/gomp/scan-3.f90 | 21 +++
gcc/testsuite/gfortran.dg/gomp/scan-4.f90 | 22 +++
gcc/testsuite/gfortran.dg/gomp/scan-5.f90 | 18 +++
gcc/testsuite/gfortran.dg/gomp/scan-6.f90 | 16 ++
gcc/testsuite/gfortran.dg/gomp/scan-7.f90 | 60 ++++++++
libgomp/testsuite/libgomp.fortran/scan-1.f90 | 115 ++++++++++++++
20 files changed, 670 insertions(+), 43 deletions(-)
@@ -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:
@@ -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
@@ -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);
@@ -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 ("%<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)
+ 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;
}
@@ -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;
@@ -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:
@@ -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:
@@ -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)
@@ -28,7 +28,7 @@ do i=1,10
end do
!$omp end parallel
-!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'parallel' construct" }
+!$omp parallel reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
do i=1,10
a = a + 1
end do
@@ -45,16 +45,6 @@ do i=1,10
a = a + 1
end do
-!$omp simd reduction(task,+:a) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do' or 'sections'" }
-do i=1,10
- a = a + 1
-end do
-
-!$omp simd reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause but not in 'scan' directive clause" }
-do i=1,10
- a = a + 1
-end do
-
! ------------ do ------------
!$omp parallel
!$omp do reduction(+:a)
@@ -77,13 +67,6 @@ do i=1,10
end do
!$omp end parallel
-!$omp parallel
-!$omp do reduction(inscan,+:a) ! { dg-error "'a' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" }
-do i=1,10
- a = a + 1
-end do
-!$omp end parallel
-
! ------------ section ------------
!$omp parallel
!$omp sections reduction(+:a)
@@ -107,7 +90,7 @@ end do
!$omp end parallel
!$omp parallel
-!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' 'reduction' clause on 'sections' construct" }
+!$omp sections reduction(inscan,+:a) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
!$omp section
a = a + 1
!$omp end sections
@@ -119,12 +102,12 @@ end do
!$omp end task
! ------------ taskloop ------------
-!$omp taskloop reduction(+:a) in_reduction(+:b)
+!$omp taskloop reduction(+:a) in_reduction(+:b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" }
do i=1,10
a = a + 1
end do
-!$omp taskloop reduction(default,+:a) in_reduction(+:b)
+!$omp taskloop reduction(default,+:a) in_reduction(+:b) ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" }
do i=1,10
a = a + 1
end do
@@ -152,9 +135,8 @@ end do
end
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(task,\\\+:a\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 8 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 7 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(\\\+:a\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
@@ -163,7 +145,6 @@ end
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(task,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp target in_reduction\\(\\\+:b\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp task in_reduction\\(\\\+:a\\)" 1 "original" } }
@@ -20,7 +20,9 @@ end do
a = a + 1
!$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
-!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "34: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
+ ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-2 }
do i=1,10
a = a + 1
end do
@@ -30,7 +32,8 @@ do i=1,10
a = a + 1
end do
-!$omp teams reduction(inscan,+:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp teams reduction(inscan,+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+ ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" "" { target *-*-* } .-1 }
a = a + 1
!$omp end teams
new file mode 100644
@@ -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
new file mode 100644
@@ -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
new file mode 100644
@@ -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
new file mode 100644
@@ -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" } }
new file mode 100644
@@ -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" } }
new file mode 100644
@@ -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" } }
new file mode 100644
@@ -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" } }
new file mode 100644
@@ -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
new file mode 100644
@@ -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
new file mode 100644
@@ -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