OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran: Add 'omp scan' support of OpenMP 5.0

Browse Source 
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.
This commit is contained in:
Tobias Burnus 2020-12-08 16:49:46 +01:00
parent e401db7bfd
commit 005cff4e2e
20 changed files with 669 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/dump-parse-tree.c
View File

@ -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:

6
gcc/fortran/gfortran.h
View File

@ -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

1
gcc/fortran/match.h
View File

@ -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);

102
gcc/fortran/openmp.c
View File

@ -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_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;
}

6
gcc/fortran/parse.c
View File

@ -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;

1
gcc/fortran/resolve.c
View File

@ -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:

1
gcc/fortran/st.c
View File

@ -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:

40
gcc/fortran/trans-openmp.c
View File

@ -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)

25
gcc/testsuite/gfortran.dg/gomp/reduction4.f90
View File

@ -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" } }

8
gcc/testsuite/gfortran.dg/gomp/reduction5.f90
View File

@ -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

18
gcc/testsuite/gfortran.dg/gomp/reduction6.f90 Normal file
View File

@ -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

9
gcc/testsuite/gfortran.dg/gomp/reduction7.f90 Normal file
View File

@ -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

213
gcc/testsuite/gfortran.dg/gomp/scan-1.f90 Normal file
View File

@ -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

21
gcc/testsuite/gfortran.dg/gomp/scan-2.f90 Normal file
View File

@ -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" } }

21
gcc/testsuite/gfortran.dg/gomp/scan-3.f90 Normal file
View File

@ -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" } }

22
gcc/testsuite/gfortran.dg/gomp/scan-4.f90 Normal file
View File

@ -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" } }

18
gcc/testsuite/gfortran.dg/gomp/scan-5.f90 Normal file
View File

@ -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" } }

16
gcc/testsuite/gfortran.dg/gomp/scan-6.f90 Normal file
View File

@ -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

60
gcc/testsuite/gfortran.dg/gomp/scan-7.f90 Normal file
View File

@ -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

115
libgomp/testsuite/libgomp.fortran/scan-1.f90 Normal file
View File

@ -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