mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2024-11-28 19:50:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Implement OpenMP 5.1 scope construct

Browse Source 
Fortran version to commit e45483c7c4,
which implemented OpenMP's scope construct for C and C++.
Most testcases are based on the C testcases; it also contains some
testcases which existed previously but had no Fortran equivalent.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
	EXEC_OMP_SCOPE.
	* gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE.
	(enum gfc_exec_op): Add EXEC_OMP_SCOPE.
	* match.h (gfc_match_omp_scope): New.
	* openmp.c (OMP_SCOPE_CLAUSES): Define
	(gfc_match_omp_scope): New.
	(gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait):
	Improve error diagnostic.
	(omp_code_to_statement): Handle ST_OMP_SCOPE.
	(gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE.
	* parse.c (decode_omp_directive, next_statement,
	gfc_ascii_statement, parse_omp_structured_block,
	parse_executable): Handle OpenMP's scope construct.
	* resolve.c (gfc_resolve_blocks): Likewise
	* st.c (gfc_free_statement): Likewise
	* trans-openmp.c (gfc_trans_omp_scope): New.
	(gfc_trans_omp_directive): Call it.
	* trans.c (trans_code): handle EXEC_OMP_SCOPE.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/scope-1.f90: New test.
	* testsuite/libgomp.fortran/task-reduction-16.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/scan-1.f90:
	* gfortran.dg/gomp/cancel-1.f90: New test.
	* gfortran.dg/gomp/cancel-4.f90: New test.
	* gfortran.dg/gomp/loop-4.f90: New test.
	* gfortran.dg/gomp/nesting-1.f90: New test.
	* gfortran.dg/gomp/nesting-2.f90: New test.
	* gfortran.dg/gomp/nesting-3.f90: New test.
	* gfortran.dg/gomp/nowait-1.f90: New test.
	* gfortran.dg/gomp/reduction-task-1.f90: New test.
	* gfortran.dg/gomp/reduction-task-2.f90: New test.
	* gfortran.dg/gomp/reduction-task-2a.f90: New test.
	* gfortran.dg/gomp/reduction-task-3.f90: New test.
	* gfortran.dg/gomp/scope-1.f90: New test.
	* gfortran.dg/gomp/scope-2.f90: New test.
This commit is contained in:
Tobias Burnus 2021-08-17 15:50:11 +02:00
parent 20698ec5b6
commit f8d535f3fe
25 changed files with 1911 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1977,6 +1977,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
case EXEC_OMP_SCAN: name = "SCAN"; break;
case EXEC_OMP_SCOPE: name = "SCOPE"; break;
case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
case EXEC_OMP_SIMD: name = "SIMD"; break;
case EXEC_OMP_SINGLE: name = "SINGLE"; break;
@ -2060,6 +2061,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
@ -3288,6 +3290,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:

4
gcc/fortran/gfortran.h
View File

@ -281,7 +281,7 @@ enum gfc_statement
ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_NONE
ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, ST_NONE
};
/* Types of interfaces that we can have. Assignment interfaces are
@ -2768,7 +2768,7 @@ enum gfc_exec_op
EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP,
EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE
};
typedef struct gfc_code

1
gcc/fortran/match.h
View File

@ -190,6 +190,7 @@ match gfc_match_omp_parallel_master_taskloop_simd (void);
match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_requires (void);
match gfc_match_omp_scope (void);
match gfc_match_omp_scan (void);
match gfc_match_omp_sections (void);
match gfc_match_omp_simd (void);

23
gcc/fortran/openmp.c
View File

@ -3150,6 +3150,8 @@ cleanup:
#define OMP_LOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \
| OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
#define OMP_SCOPE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION)
#define OMP_SECTIONS_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
@ -4487,6 +4489,13 @@ gfc_match_omp_scan (void)
}
match
gfc_match_omp_scope (void)
{
return match_omp (EXEC_OMP_SCOPE, OMP_SCOPE_CLAUSES);
}
match
gfc_match_omp_sections (void)
{
@ -4975,7 +4984,11 @@ gfc_match_omp_cancellation_point (void)
gfc_omp_clauses *c;
enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
if (kind == OMP_CANCEL_UNKNOWN)
return MATCH_ERROR;
{
gfc_error ("Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP "
"in $OMP CANCELLATION POINT statement at %C");
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement "
@ -4998,7 +5011,10 @@ gfc_match_omp_end_nowait (void)
nowait = true;
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after NOWAIT clause at %C");
if (nowait)
gfc_error ("Unexpected junk after NOWAIT clause at %C");
else
gfc_error ("Unexpected junk at %C");
return MATCH_ERROR;
}
new_st.op = EXEC_OMP_END_NOWAIT;
@ -7448,6 +7464,8 @@ omp_code_to_statement (gfc_code *code)
return ST_OMP_DO_SIMD;
case EXEC_OMP_SCAN:
return ST_OMP_SCAN;
case EXEC_OMP_SCOPE:
return ST_OMP_SCOPE;
case EXEC_OMP_SIMD:
return ST_OMP_SIMD;
case EXEC_OMP_TARGET:
@ -7948,6 +7966,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_PARALLEL_MASKED:
case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TARGET:

13
gcc/fortran/parse.c
View File

@ -951,6 +951,7 @@ decode_omp_directive (void)
matcho ("end parallel workshare", gfc_match_omp_eos_error,
ST_OMP_END_PARALLEL_WORKSHARE);
matcho ("end parallel", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL);
matcho ("end scope", gfc_match_omp_end_nowait, ST_OMP_END_SCOPE);
matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
matcho ("end target data", gfc_match_omp_eos_error, ST_OMP_END_TARGET_DATA);
@ -1052,6 +1053,7 @@ decode_omp_directive (void)
break;
case 's':
matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN);
matcho ("scope", gfc_match_omp_scope, ST_OMP_SCOPE);
matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION);
matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE);
@ -1672,7 +1674,7 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP: \
case ST_OMP_MASKED_TASKLOOP_SIMD: \
case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \
case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SINGLE: \
case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \
@ -2609,6 +2611,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_SCAN:
p = "!$OMP SCAN";
break;
case ST_OMP_SCOPE:
p = "!$OMP SCOPE";
break;
case ST_OMP_SECTIONS:
p = "!$OMP SECTIONS";
break;
@ -5463,6 +5468,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_PARALLEL_SECTIONS:
omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
break;
case ST_OMP_SCOPE:
omp_end_st = ST_OMP_END_SCOPE;
break;
case ST_OMP_SECTIONS:
omp_end_st = ST_OMP_END_SECTIONS;
break;
@ -5763,11 +5771,12 @@ parse_executable (gfc_statement st)
case ST_OMP_PARALLEL_MASKED:
case ST_OMP_PARALLEL_MASTER:
case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_SECTIONS:
case ST_OMP_ORDERED:
case ST_OMP_CRITICAL:
case ST_OMP_MASKED:
case ST_OMP_MASTER:
case ST_OMP_SCOPE:
case ST_OMP_SECTIONS:
case ST_OMP_SINGLE:
case ST_OMP_TARGET:
case ST_OMP_TARGET_DATA:

2
gcc/fortran/resolve.c
View File

@ -10839,6 +10839,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TARGET:
case EXEC_OMP_TARGET_DATA:
@ -12262,6 +12263,7 @@ start:
case EXEC_OMP_MASKED_TASKLOOP_SIMD:
case EXEC_OMP_ORDERED:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:

1
gcc/fortran/st.c
View File

@ -246,6 +246,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:

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

@ -6264,6 +6264,24 @@ gfc_trans_omp_parallel_workshare (gfc_code *code)
return gfc_finish_block (&block);
}
static tree
gfc_trans_omp_scope (gfc_code *code)
{
stmtblock_t block;
tree body = gfc_trans_code (code->block->next);
if (IS_EMPTY_STMT (body))
return body;
gfc_start_block (&block);
tree omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
code->loc);
tree stmt = make_node (OMP_SCOPE);
TREE_TYPE (stmt) = void_type_node;
OMP_SCOPE_BODY (stmt) = body;
OMP_SCOPE_CLAUSES (stmt) = omp_clauses;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
static tree
gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
{
@ -7110,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_parallel_sections (code);
case EXEC_OMP_PARALLEL_WORKSHARE:
return gfc_trans_omp_parallel_workshare (code);
case EXEC_OMP_SCOPE:
return gfc_trans_omp_scope (code);
case EXEC_OMP_SECTIONS:
return gfc_trans_omp_sections (code, code->ext.omp_clauses);
case EXEC_OMP_SINGLE:

1
gcc/fortran/trans.c
View File

@ -2175,6 +2175,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:

539
gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 Normal file
View File

@ -0,0 +1,539 @@
! { dg-additional-options "-cpp" }
subroutine f1
!$omp cancel parallel ! { dg-error "orphaned" }
!$omp cancel do ! { dg-error "orphaned" }
!$omp cancel sections ! { dg-error "orphaned" }
!$omp cancel taskgroup ! { dg-error "orphaned" }
!$omp cancellation point parallel ! { dg-error "orphaned" }
!$omp cancellation point do ! { dg-error "orphaned" }
!$omp cancellation point sections ! { dg-error "orphaned" }
!$omp cancellation point taskgroup ! { dg-error "orphaned" }
end
subroutine f2
integer :: i, j
j = 0
!$omp parallel
!$omp cancel parallel
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp master
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end master
!$omp masked
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end masked
!$omp scope
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end scope
!$omp single
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end single
!$omp critical
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end critical
!$omp taskgroup
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end taskgroup
!$omp task
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
!$omp taskgroup
!$omp task
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup
!$omp end task
!$omp end taskgroup
!$omp taskloop
do i = 0, 9
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup
!$omp task
!$omp cancellation point taskgroup
!$omp cancel taskgroup
!$omp end task
end do
!$omp taskloop nogroup
do i = 0, 9
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp task
!$omp cancellation point taskgroup! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
end do
!$omp taskgroup
!$omp task
!$omp task
!$omp cancellation point taskgroup
!$omp cancel taskgroup
!$omp end task
!$omp end task
!$omp taskloop nogroup
do i = 0, 9
!$omp task
!$omp cancellation point taskgroup
!$omp cancel taskgroup
!$omp end task
!$omp cancellation point taskgroup
!$omp cancel taskgroup
end do
!$omp end taskgroup
!$omp taskgroup
!$omp parallel
!$omp task
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
!$omp taskloop
do i = 0, 9
!$omp cancel taskgroup
!$omp cancellation point taskgroup
end do
!$omp taskloop nogroup
do i = 0, 9
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
end do
!$omp end parallel
!$omp target
!$omp task
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
!$omp end target
!$omp target
!$omp teams
!$omp distribute
do i = 0, 9
!$omp task
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
end do
!$omp end distribute
!$omp end teams
!$omp end target
!$omp target data map(i)
!$omp task
!$omp cancel taskgroup
!$omp cancellation point taskgroup
!$omp end task
!$omp end target data
!$omp end taskgroup
!$omp taskloop
do i = 0, 9
!$omp parallel
!$omp task
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
!$omp end parallel
!$omp target
!$omp task
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
!$omp end target
!$omp target
!$omp teams
!$omp distribute
do j = 0, 9
!$omp task
!$omp cancel taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp cancellation point taskgroup ! { dg-error "construct not closely nested inside of .taskgroup. region" }
!$omp end task
end do
!$omp end distribute
!$omp end teams
!$omp end target
!$omp target data map(i)
!$omp task
!$omp cancel taskgroup
!$omp cancellation point taskgroup
!$omp end task
!$omp end target data
end do
!$omp do
do i = 0, 9
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup! { dg-error "not closely nested inside" }
end do
!$omp do ordered
do i = 0, 9
!$omp ordered
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup! { dg-error "not closely nested inside" }
!$omp end ordered
end do
!$omp end do
!$omp sections
block
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections
!$omp cancellation point taskgroup! { dg-error "not closely nested inside" }
end block
!$omp section
block
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections
!$omp cancellation point taskgroup! { dg-error "not closely nested inside" }
end block
!$omp target data map(j)
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target data
!$omp target
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target
!$omp end sections
!$omp end parallel
!$omp target data map(j)
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target data
!$omp target
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target
!$omp target teams
!$omp cancel parallel ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancel do ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancel sections ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancel taskgroup ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancellation point parallel ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancellation point do ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancellation point sections ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp cancellation point taskgroup ! { dg-error "only .distribute., .parallel. or .loop. regions are allowed to be strictly nested" }
!$omp end target teams
!$omp target teams distribute
do i = 0, 9
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
end do
!$omp end target teams distribute
!$omp do
do i = 0, 9
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
end do
!$omp do
do i = 0, 9
!$omp target data map(j)
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target data
end do
!$omp do
do i = 0, 9
!$omp target
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target
end do
!$omp do ordered
do i = 0, 9
!$omp ordered
!$omp target data map(j)
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup! { dg-error "not closely nested inside" }
!$omp end target data
!$omp end ordered
end do
do i = 0, 9
!$omp ordered
!$omp target
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup! { dg-error "not closely nested inside" }
!$omp end target
!$omp end ordered
end do
!$omp sections
block
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
end block
!$omp section
block
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
end block
!$omp end sections
!$omp sections
!$omp target data map(j)
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target data
!$omp section
!$omp target data map(j)
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target data
!$omp end sections
!$omp sections
!$omp target
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target
!$omp section
!$omp target
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end target
!$omp end sections
!$omp task
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup
!$omp taskgroup
!$omp cancel parallel ! { dg-error "not closely nested inside" }
!$omp cancel do ! { dg-error "not closely nested inside" }
!$omp cancel sections ! { dg-error "not closely nested inside" }
!$omp cancel taskgroup ! { dg-error "not closely nested inside" }
!$omp cancellation point parallel ! { dg-error "not closely nested inside" }
!$omp cancellation point do ! { dg-error "not closely nested inside" }
!$omp cancellation point sections ! { dg-error "not closely nested inside" }
!$omp cancellation point taskgroup ! { dg-error "not closely nested inside" }
!$omp end taskgroup
!$omp end task
end
subroutine f3
integer i
!$omp do
do i = 0, 9
!$omp cancel do ! { dg-warning "nowait" }
end do
!$omp end do nowait
!$omp sections
block
!$omp cancel sections ! { dg-warning "nowait" }
end block
!$omp section
block
!$omp cancel sections ! { dg-warning "nowait" }
end block
!$omp end sections nowait
!$omp do ordered
do i = 0, 9
!$omp cancel do ! { dg-warning "ordered" }
!$omp ordered
!$omp end ordered
end do
end
subroutine f4
! if (.false.) then
!$omp cancellation point do ! { dg-error "orphaned 'cancellation point' construct" }
! end if
end

9
gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 Normal file
View File

@ -0,0 +1,9 @@
subroutine f4
!$omp cancellation point ! { dg-error "Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP in .OMP CANCELLATION POINT statement at" }
if (.false.) then
!$omp cancellation EKAHI ! { dg-error "Unclassifiable OpenMP directive" }
end if
!$omp cancellation HO OKAHI ! { dg-error "Unclassifiable OpenMP directive" }
!$omp cancellation point ! { dg-error "Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP in .OMP CANCELLATION POINT statement at" }
end

279
gcc/testsuite/gfortran.dg/gomp/loop-4.f90 Normal file
View File

@ -0,0 +1,279 @@
module m
use iso_c_binding, only: c_loc
implicit none (type, external)
integer :: v
interface
subroutine foo (); end
integer function omp_get_thread_num (); end
integer function omp_get_num_threads (); end
integer function omp_get_cancellation (); end
integer(c_int) function omp_target_is_present(ptr, device_num) bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_int
type(c_ptr), value :: ptr
integer(c_int), value :: device_num
end
end interface
contains
subroutine f1(a)
integer :: a(0:)
integer :: i, j
!$omp simd order(concurrent)
do i = 0, 63
!$omp loop
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
end
subroutine f2 (a)
integer :: a(0:)
integer :: i, j
!$omp do simd order(concurrent)
do i = 0, 63
!$omp loop
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
end
subroutine f3 (a)
integer :: a(0:)
integer :: i, j
!$omp do order(concurrent)
do i = 0, 63
!$omp loop
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
end
subroutine f4 (a)
integer, target :: a(0:)
integer :: i, j
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp parallel
call foo ()
!$omp end parallel
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp simd
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp loop
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end critical
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end ordered
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
v = v + 1
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
a(i) = v
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
!$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
v = a(i)
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop order(concurrent) bind(parallel)
do i = 0, 63
a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
end
subroutine f5 (a)
integer, target :: a(0:)
integer :: i, j
!$omp parallel
!$omp loop
do i = 0, 63
!$omp parallel
call foo ()
!$omp end parallel
end do
!$omp loop
do i = 0, 63
!$omp simd
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
!$omp loop
do i = 0, 63
!$omp loop
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
!$omp loop
do i = 0, 63
!$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end critical
end do
!$omp loop
do i = 0, 63
!$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end ordered
end do
!$omp loop
do i = 0, 63
!$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
v = v + 1
end do
!$omp loop
do i = 0, 63
!$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
a(i) = v
end do
!$omp loop
do i = 0, 63
!$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
v = a(i)
end do
!$omp loop
do i = 0, 63
!$omp master ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end master
end do
!$omp loop
do i = 0, 63
!$omp masked ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end masked
end do
!$omp loop
do i = 0, 63
!$omp scope ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end scope
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp end parallel
end
subroutine f6 (a)
integer, target :: a(0:)
integer :: i, j
!$omp master
!$omp loop
do i = 0, 63
!$omp parallel
call foo ()
!$omp end parallel
end do
!$omp loop
do i = 0, 63
!$omp simd
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
!$omp loop
do i = 0, 63
!$omp loop
do j = 0, 63
a(64 * i + j) = i + j
end do
end do
!$omp loop
do i = 0, 63
!$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end critical
end do
!$omp loop
do i = 0, 63
!$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
call foo ()
!$omp end ordered
end do
!$omp loop
do i = 0, 63
!$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
v = v + 1
end do
!$omp loop
do i = 0, 63
!$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
a(i) = v
end do
!$omp loop
do i = 0, 63
!$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a 'loop' region" }
v = a(i)
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp loop
do i = 0, 63
a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
end do
!$omp end master
end
end module

68
gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 Normal file
View File

@ -0,0 +1,68 @@
module m
implicit none
integer i
contains
subroutine f_omp_parallel
!$omp parallel
!$omp parallel
!$omp end parallel
!$omp target
!$omp end target
!$omp target data map(i)
!$omp end target data
!$omp target update to(i)
!$omp target data map(i)
!$omp parallel
!$omp end parallel
!$omp target
!$omp end target
!$omp target data map(i)
!$omp end target data
!$omp target update to(i)
!$omp end target data
!$omp end parallel
end
subroutine f_omp_target
!$omp target
!$omp parallel
!$omp end parallel
!$omp end target
end
subroutine f_omp_target_data
!$omp target data map(i)
!$omp parallel
!$omp end parallel
!$omp target
!$omp end target
!$omp target data map(i)
!$omp end target data
!$omp target update to(i)
!$omp target data map(i)
!$omp parallel
!$omp end parallel
!$omp target
!$omp end target
!$omp target data map(i)
!$omp end target data
!$omp target update to(i)
!$omp end target data
!$omp end target data
end
end module m

165
gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 Normal file
View File

@ -0,0 +1,165 @@
subroutine foo
integer :: i, j
!$omp taskloop
do i = 0, 63
!$omp do ! { dg-error "region may not be closely nested inside of" }
do j = 0, 9
end do
!$omp single ! { dg-error "region may not be closely nested inside of" }
!$omp end single
!$omp sections ! { dg-error "region may not be closely nested inside of" }
!$omp section
block
end block
!$omp end sections
!$omp barrier ! { dg-error "region may not be closely nested inside of" }
!$omp master ! { dg-error "region may not be closely nested inside of" } -- ?
block; end block ! otherwise not generated
!$omp end master
!$omp masked ! { dg-error "region may not be closely nested inside of" } -- ?
block; end block ! otherwise not generated
!$omp end masked
!$omp scope ! { dg-error "region may not be closely nested inside of" } -- ?
block; end block ! otherwise not generated
!$omp end scope
!$omp ordered ! { dg-error "region may not be closely nested inside of" }
!$omp end ordered
!$omp ordered threads ! { dg-error "region may not be closely nested inside of" }
!$omp end ordered
!$omp ordered simd threads ! { dg-error ".ordered. .simd. must be closely nested inside .simd. region" }
!$omp end ordered
!$omp simd
do j = 0, 9
!$omp ordered simd
!$omp end ordered
end do
!$omp critical
!$omp simd
do j = 0, 9
!$omp ordered simd
!$omp end ordered
end do
!$omp end critical
end do
!$omp taskloop
do i = 0, 63
!$omp parallel
!$omp do
do j = 0, 9
end do
!$omp single
!$omp end single
!$omp sections
!$omp section
block; end block
!$omp end sections
!$omp barrier
!$omp master
block; end block ! otherwise not generated
!$omp end master
!$omp masked
block; end block ! otherwise not generated
!$omp end masked
!$omp scope
block; end block ! otherwise not generated
!$omp end scope
!$omp ordered ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" }
!$omp end ordered
!$omp ordered threads ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" }
!$omp end ordered
!$omp simd
do j = 0, 9
!$omp ordered simd
!$omp end ordered
end do
!$omp critical
!$omp simd
do j = 0, 9
!$omp ordered simd
!$omp end ordered
end do
!$omp end critical
!$omp end parallel
end do
!$omp taskloop
do i = 0, 63
!$omp target
!$omp do
do j = 0, 9
end do
!$omp single
!$omp end single
!$omp sections
!$omp section
block; end block
!$omp end sections
!$omp barrier
!$omp master
block; end block ! otherwise not generated
!$omp end master
!$omp masked
block; end block ! otherwise not generated
!$omp end masked
!$omp scope
block; end block ! otherwise not generated
!$omp end scope
!$omp ordered ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" }
!$omp end ordered
!$omp ordered threads ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" }
!$omp end ordered
!$omp simd
do j = 0, 9
!$omp ordered simd
!$omp end ordered
end do
!$omp critical
!$omp simd
do j = 0, 9
!$omp ordered simd
!$omp end ordered
end do
!$omp end critical
!$omp end target
end do
!$omp ordered
!$omp ordered ! { dg-error "region may not be closely nested inside of" }
!$omp end ordered
!$omp end ordered
!$omp ordered threads
!$omp ordered ! { dg-error "region may not be closely nested inside of" }
!$omp end ordered
!$omp end ordered
!$omp ordered
!$omp ordered threads ! { dg-error "region may not be closely nested inside of" }
!$omp end ordered
!$omp end ordered
!$omp ordered threads
!$omp ordered threads ! { dg-error "region may not be closely nested inside of" }
!$omp end ordered
!$omp end ordered
!$omp critical
!$omp ordered simd ! { dg-error ".ordered. .simd. must be closely nested inside .simd. region" }
!$omp end ordered
!$omp end critical
!$omp do ordered
do i = 0, 63
!$omp parallel
!$omp ordered threads ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" }
!$omp end ordered
!$omp end parallel
end do
!$omp do ordered
do i = 0, 63
!$omp parallel
!$omp ordered ! { dg-error ".ordered. region must be closely nested inside a loop region with an .ordered. clause" }
!$omp end ordered
!$omp end parallel
end do
!$omp do ordered(1)
do i = 0, 63
!$omp parallel
!$omp ordered depend(source) ! { dg-error ".ordered. construct with .depend. clause must be closely nested inside a loop with .ordered. clause with a parameter" }
!$omp ordered depend(sink: i - 1) ! { dg-error ".ordered. construct with .depend. clause must be closely nested inside a loop with .ordered. clause with a parameter" }
!$omp end parallel
end do
end

347
gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 Normal file
View File

@ -0,0 +1,347 @@
subroutine f1
integer i, j
!$omp do
do i = 0, 2
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp master ! { dg-error "may not be closely nested" }
block; end block
!$omp end master
!$omp masked ! { dg-error "may not be closely nested" }
block; end block
!$omp end masked
!$omp barrier ! { dg-error "may not be closely nested" }
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
end do
!$omp sections
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp end sections
!$omp sections
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp end sections
!$omp sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp end sections
!$omp sections
!$omp master ! { dg-error "may not be closely nested" }
block; end block
!$omp end master
!$omp end sections
!$omp sections
!$omp masked ! { dg-error "may not be closely nested" }
block; end block
!$omp end masked
!$omp end sections
!$omp sections
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end sections
!$omp sections
!$omp section
block; end block
!$omp end sections
!$omp sections
!$omp section
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp end sections
!$omp sections
!$omp section
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp end sections
!$omp sections
!$omp section
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp end sections
!$omp sections
!$omp section
!$omp master ! { dg-error "may not be closely nested" }
block; end block
!$omp end master
!$omp section
!$omp masked ! { dg-error "may not be closely nested" }
block; end block
!$omp end masked
!$omp end sections
!$omp sections
!$omp section
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end sections
!$omp single
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp master ! { dg-error "may not be closely nested" }
block; end block
!$omp end master
!$omp masked ! { dg-error "may not be closely nested" }
block; end block
!$omp end masked
!$omp barrier ! { dg-error "may not be closely nested" }
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end single
!$omp master
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp master
block; end block
!$omp end master
!$omp barrier ! { dg-error "may not be closely nested" }
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end master
!$omp masked filter (1)
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp master
block; end block
!$omp end master
!$omp barrier ! { dg-error "may not be closely nested" }
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end masked
!$omp task
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp master ! { dg-error "may not be closely nested" }
block; end block
!$omp end master
!$omp masked ! { dg-error "may not be closely nested" }
block; end block
!$omp end masked
!$omp barrier ! { dg-error "may not be closely nested" }
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end task
!$omp parallel
!$omp do
do j = 0, 2
block; end block
end do
!$omp sections
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single
block; end block
!$omp end single
!$omp master
block; end block
!$omp end master
!$omp masked
block; end block
!$omp end masked
!$omp barrier
!$omp scope
block; end block
!$omp end scope
!$omp scope
!$omp scope
block; end block
!$omp end scope
!$omp end scope
!$omp end parallel
!$omp scope
!$omp do
do j = 0, 2
block; end block
end do
!$omp sections
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single
block; end block
!$omp end single
!$omp master
block; end block
!$omp end master
!$omp masked
block; end block
!$omp end masked
!$omp barrier
!$omp scope
block; end block
!$omp end scope
!$omp scope
!$omp scope
block; end block
!$omp end scope
!$omp end scope
!$omp end scope
end
subroutine f2
integer i, j
!$omp ordered
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
block; end block
!$omp section
block; end block
!$omp end sections
!$omp single ! { dg-error "may not be closely nested" }
block; end block
!$omp end single
!$omp master
block; end block
!$omp end master
!$omp masked
block; end block
!$omp end masked
!$omp barrier ! { dg-error "may not be closely nested" }
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end ordered
end
subroutine f3 (void)
!$omp critical
!$omp ordered ! { dg-error "may not be closely nested" }
block; end block
!$omp end ordered
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end critical
end
subroutine f4 (void)
!$omp task
!$omp ordered ! { dg-error "may not be closely nested" }
block; end block
!$omp end ordered
!$omp scope ! { dg-error "may not be closely nested" }
block; end block
!$omp end scope
!$omp end task
end
subroutine f5 (void)
integer i
!$omp do
do i = 0, 9
!$omp ordered ! { dg-error "must be closely nested" }
block; end block
!$omp end ordered
end do
!$omp do ordered
do i = 0, 9
!$omp ordered
block; end block
!$omp end ordered
end do
end
subroutine f6 (void)
!$omp critical (foo)
!$omp critical (bar)
block; end block
!$omp end critical (bar)
!$omp end critical (foo)
!$omp critical
!$omp critical (baz)
block; end block
!$omp end critical (baz)
!$omp end critical
end
subroutine f7 (void)
!$omp critical (foo2)
!$omp critical
block; end block
!$omp end critical
!$omp end critical (foo2)
!$omp critical (bar)
!$omp critical (bar) ! { dg-error "may not be nested" }
block; end block
!$omp end critical (bar)
!$omp end critical (bar)
!$omp critical
!$omp critical ! { dg-error "may not be nested" }
block; end block
!$omp end critical
!$omp end critical
end

19
gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 Normal file
View File

@ -0,0 +1,19 @@
subroutine foo
!$omp do
do i = 1, 2
end do
!$omp end do nowait foo ! { dg-error "Unexpected junk after NOWAIT clause" }
!$omp end do ! as previous line is ignored
!$omp scope
block; end block
!$omp end scope bar ! { dg-error "Unexpected junk at" }
!$omp end scope
!$omp scope
block; end block
!$omp end scope nowait nowait ! { dg-error "Unexpected junk after NOWAIT clause" }
!$omp end scope
end

112
gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90 Normal file
View File

@ -0,0 +1,112 @@
module m
implicit none
integer v
interface
subroutine foo(x)
integer, value :: x
end
end interface
contains
subroutine bar
integer i
!$omp do reduction (task, +: v)
do i = 0, 63
call foo (i)
end do
!$omp sections reduction (task, +: v)
call foo (-2)
!$omp section
call foo (-3)
!$omp end sections
!$omp parallel reduction (task, +: v)
call foo (-1)
!$omp end parallel
!$omp parallel do reduction (task, +: v)
do i = 0, 63
call foo (i)
end do
!$omp end parallel do
!$omp parallel sections reduction (task, +: v)
call foo (-2)
!$omp section
call foo (-3)
!$omp end parallel sections
!$omp teams distribute parallel do reduction (task, +: v) ! { dg-bogus "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" "PR101948" { xfail *-*-* } }
do i = 0, 63
call foo (i)
end do
!$omp end teams distribute parallel do
!$omp do reduction (default, +: v)
do i = 0, 63
call foo (i)
end do
!$omp sections reduction (default, +: v)
call foo (-2)
!$omp section
call foo (-3)
!$omp end sections
!$omp parallel reduction (default, +: v)
call foo (-1)
!$omp end parallel
!$omp parallel do reduction (default, +: v)
do i = 0, 63
call foo (i)
end do
!$omp end parallel do
!$omp parallel sections reduction (default, +: v)
call foo (-2)
!$omp section
call foo (-3)
!$omp end parallel sections
!$omp teams distribute parallel do reduction (default, +: v)
do i = 0, 63
call foo (i)
end do
!$omp end teams distribute parallel do
!$omp do reduction (default, +: v)
do i = 0, 63
call foo (i)
end do
!$omp end do nowait
!$omp sections reduction (default, +: v)
call foo (-2)
!$omp section
call foo (-3)
!$omp end sections nowait
!$omp simd reduction (default, +: v)
do i = 0, 63
v = v + 1
end do
!$omp do simd reduction (default, +: v)
do i = 0, 63
v = v + 1
end do
!$omp parallel do simd reduction (default, +: v)
do i = 0, 63
v = v + 1
end do
!$omp end parallel do simd
!$omp teams distribute parallel do simd reduction (default, +: v)
do i = 0, 63
v = v + 1
end do
!$omp end teams distribute parallel do simd
!$omp taskloop reduction (default, +: v)
do i = 0, 63
call foo (i)
end do
!$omp taskloop simd reduction (default, +: v)
do i = 0, 63
v = v + 1
end do
!$omp teams reduction (default, +: v)
call foo (i)
!$omp end teams
!$omp teams distribute reduction (default, +: v)
do i = 0, 63
call foo (i)
end do
!$omp end teams distribute
end
end

45
gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90 Normal file
View File

@ -0,0 +1,45 @@
module m
integer :: v
interface
subroutine foo(i)
integer :: i
end
end interface
end
subroutine bar
use m
implicit none
integer :: i
!$omp do reduction (task, +: v) ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" }
do i = 0, 63
call foo (i)
end do
!$omp end do nowait
!$omp sections reduction (task, +: v) ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" }
call foo (-2)
!$omp section
call foo (-3)
!$omp end sections nowait
!$omp scope reduction (task, +: v) ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" }
call foo (-4)
!$omp end scope nowait
!$omp simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
do i = 0, 63
v = v + 1
end do
!$omp do simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
do i = 0, 63
v = v + 1
end do
!$omp parallel do simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
do i = 0, 63
v = v + 1
end do
!$omp end parallel do simd
!$omp teams distribute parallel do simd reduction (task, +: v) ! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
do i = 0, 63
v = v + 1
end do
!$omp end teams distribute parallel do simd
end

30
gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90 Normal file
View File

@ -0,0 +1,30 @@
module m
integer :: v
interface
subroutine foo(i)
integer :: i
end
end interface
end
subroutine bar
use m
implicit none
integer :: i
!$omp taskloop reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
do i = 0, 63
call foo (i)
end do
!$omp taskloop simd reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
do i = 0, 63
v = v + 1
end do
!$omp teams reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
call foo (i)
!$omp end teams
!$omp teams distribute reduction (task, +: v) ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
do i = 0, 63
call foo (i)
end do
!$omp end teams distribute
end

15
gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90 Normal file
View File

@ -0,0 +1,15 @@
! Fortran testcase of reduction-task-3.f90 ( PR c/91149 )
module m
integer :: r
end
subroutine foo
use m
!$omp parallel reduction(task, +: r)
r = r + 1
!$omp end parallel
!$omp target parallel reduction(task, +: r)
r = r + 1
!$omp end target parallel
end

5
gcc/testsuite/gfortran.dg/gomp/scan-1.f90
View File

@ -105,6 +105,11 @@ subroutine f3 (c, d)
! ...
!$omp end teams
!$omp scope reduction (inscan, +: a)
! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
! ...
!$omp end scope
!$omp target parallel do reduction (inscan, +: a) map (c, d)
! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
do i = 1, 64

39
gcc/testsuite/gfortran.dg/gomp/scope-1.f90 Normal file
View File

@ -0,0 +1,39 @@
module m
implicit none (external, type)
integer :: r, r2, r3
contains
subroutine foo
integer :: i, j, k
i = 0; j = 0; k = 0
!$omp scope private (i) reduction (+:r)
i = 1
r = r + 1
!$omp end scope nowait
!$omp scope private (i) reduction (task, +:r)
!$omp scope private (j) reduction (task, +:r2)
!$omp scope private (k) reduction (task, +:r3)
i = 1
j = 2
k = 3
r = r + 1
r2 = r2 + 1
r3 = r3 + 1
!$omp end scope
!$omp end scope
!$omp end scope
!$omp parallel
!$omp scope reduction (+:r) private (i)
!$omp scope reduction (+:r2) private (j)
!$omp single
i = 1
j = 2
r = r + 1
r2 = r2 + 1
!$omp end single
!$omp end scope nowait
!$omp end scope nowait
!$omp end parallel
end
end module

40
gcc/testsuite/gfortran.dg/gomp/scope-2.f90 Normal file
View File

@ -0,0 +1,40 @@
module m
implicit none (type, external)
integer :: r, r2, r3 = 1
interface
logical function bar(); end
end interface
contains
subroutine foo
integer :: i, j, k
i = 0; j = 0; k = 0
!$omp parallel
if (bar ()) then
!$omp cancel parallel
end if
!$omp scope reduction (+:r) private (i)
!$omp scope reduction (+:r2) private (j)
!$omp single
i = 1;
j = 2;
r = r + 1
r2 = r2 + 1
!$omp end single nowait
!$omp end scope
!$omp end scope
!$omp end parallel
!$omp parallel
if (bar ()) then
!$omp cancel parallel
end if
!$omp scope reduction (task, +:r) private (i)
!$omp scope reduction (task, *:r3)
r = r + 1
r3 = r3 + 1
!$omp end scope
!$omp end scope
!$omp end parallel
end
end module

55
libgomp/testsuite/libgomp.fortran/scope-1.f90 Normal file
View File

@ -0,0 +1,55 @@
program main
implicit none (type, external)
integer :: r, r2, i
integer a(0:63)
a = 0
r = 0; r2 = 0
!$omp parallel
!$omp scope
!$omp scope
!$omp do
do i = 0, 63
a(i) = a(i) + 1
end do
!$omp end do
!$omp end scope nowait
!$omp end scope nowait
!$omp scope reduction(+: r)
!$omp do
do i = 0, 63
r = r + i
if (a(i) /= 1) &
stop 1
end do
!$omp end do nowait
!$omp barrier
!$omp end scope nowait
!$omp barrier
if (r /= 64 * 63 / 2) &
stop 2
!$omp scope private (i)
!$omp scope reduction(+: r2)
!$omp do
do i = 0, 63
r2 = r2 + 2 * i
a(i) = a(i) + i
end do
!$omp end do nowait
!$omp end scope
!$omp end scope nowait
if (r2 /= 64 * 63) &
stop 3
!$omp do
do i = 0, 63
if (a(i) /= i + 1) &
stop 4
end do
!$omp end do nowait
!$omp end parallel
end

82
libgomp/testsuite/libgomp.fortran/task-reduction-16.f90 Normal file
View File

@ -0,0 +1,82 @@
module m
implicit none (external, type)
integer :: a, b(0:2) = [1, 1, 1]
integer(8) :: c(0:1) = [not(0_8), not(0_8)]
contains
subroutine bar (i)
integer :: i
!$omp task in_reduction (*: b) in_reduction (iand: c) &
!$omp& in_reduction (+: a)
a = a + 4
b(1) = b(1) * 4
c(1) = iand (c(1), not(ishft(1_8, i + 16)))
!$omp end task
end subroutine bar
subroutine foo (x)
integer :: x
!$omp scope reduction (task, +: a)
!$omp scope reduction (task, *: b)
!$omp scope reduction (task, iand: c)
!$omp barrier
!$omp sections
block
a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3
c(1) = iand(c(1), not(ishft(1_8, 2)))
end block
!$omp section
block
b(0) = b(0) * 2; call bar (4); b(2) = b(2) * 3
c(1) = iand(c(1), not(ishft(1_8, 4))); a = a + 1
end block
!$omp section
block
call bar (6); b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 6)))
a = a + 1; b(0) = b(0) * 2
end block
!$omp section
block
b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 8)))
a = a + 1; b(0) = b(0) * 2; call bar (8)
end block
!$omp section
block
c(1) = iand(c(1), not(ishft(1_8, 10))); a = a + 1
b(0) = b(0) * 2; call bar (10); b(2) = b(2) * 3
end block
!$omp section
block
a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
c(1) = iand(c(1), not(ishft(1_8, 12))); call bar (12)
end block
!$omp section
if (x /= 0) then
a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
call bar (14); c(1) = iand (c(1), not(ishft(1_8, 14)))
end if
!$omp end sections
!$omp end scope
!$omp end scope
!$omp end scope
end subroutine foo
end module m
program main
use m
implicit none (type, external)
integer, volatile :: one
one = 1
call foo (0)
if (a /= 30 .or. b(0) /= 64 .or. b(1) /= ishft (1, 12) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 &
.or. c(0) /= not(0_8) .or. c(1) /= not(int(z'15541554', kind=8))) &
stop 1
a = 0
b(:) = [1, 1, 1]
c(1) = not(0_8)
!$omp parallel
call foo (one)
!$omp end parallel
if (a /= 35 .or. b(0) /= 128 .or. b(1) /= ishft(1, 14) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 * 3 &
.or. c(0) /= not(0_8) .or. c(1) /= not(int(z'55545554', kind=8))) &
stop 2
end program main