public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-2962] Fortran: Implement OpenMP 5.1 scope construct
@ 2021-08-17 13:51 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2021-08-17 13:51 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:f8d535f3fec81c1cc84e22df5500e693544ec65b
commit r12-2962-gf8d535f3fec81c1cc84e22df5500e693544ec65b
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Tue Aug 17 15:50:11 2021 +0200
Fortran: Implement OpenMP 5.1 scope construct
Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f,
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.
Diff:
---
gcc/fortran/dump-parse-tree.c | 3 +
gcc/fortran/gfortran.h | 4 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 23 +-
gcc/fortran/parse.c | 13 +-
gcc/fortran/resolve.c | 2 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 20 +
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 | 539 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 | 9 +
gcc/testsuite/gfortran.dg/gomp/loop-4.f90 | 279 +++++++++++
gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 | 68 +++
gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 | 165 +++++++
gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 | 347 +++++++++++++
gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 | 19 +
.../gfortran.dg/gomp/reduction-task-1.f90 | 112 +++++
.../gfortran.dg/gomp/reduction-task-2.f90 | 45 ++
.../gfortran.dg/gomp/reduction-task-2a.f90 | 30 ++
.../gfortran.dg/gomp/reduction-task-3.f90 | 15 +
gcc/testsuite/gfortran.dg/gomp/scan-1.f90 | 5 +
gcc/testsuite/gfortran.dg/gomp/scope-1.f90 | 39 ++
gcc/testsuite/gfortran.dg/gomp/scope-2.f90 | 40 ++
libgomp/testsuite/libgomp.fortran/scope-1.f90 | 55 +++
.../libgomp.fortran/task-reduction-16.f90 | 82 ++++
25 files changed, 1911 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 53c49fe4d6f..92d9f9e054d 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -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:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fde4174a5b..a7d82ae38c2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index dce650346d3..aac16a8d3d0 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1bce43cb33e..9675b658409 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -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:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e1d78de5d9e..24cc9bfb9f1 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8eb8a9ab6d7..117062b48d8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index f61f88adcc5..7d87709d387 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -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:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 623c21fc790..e0a001420e6 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ce5b2f8d594..80b724d0839 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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:
diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90
new file mode 100644
index 00000000000..d60dd72bd4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-4.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-4.f90
new file mode 100644
index 00000000000..0fb814e42e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/cancel-4.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-4.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-4.f90
new file mode 100644
index 00000000000..73745893c69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-4.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-1.f90 b/gcc/testsuite/gfortran.dg/gomp/nesting-1.f90
new file mode 100644
index 00000000000..af4c2fbfef3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/nesting-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-2.f90 b/gcc/testsuite/gfortran.dg/gomp/nesting-2.f90
new file mode 100644
index 00000000000..2eccdf9b034
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/nesting-2.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
new file mode 100644
index 00000000000..cd2e39ae082
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/nowait-1.f90 b/gcc/testsuite/gfortran.dg/gomp/nowait-1.f90
new file mode 100644
index 00000000000..b47b4a14e86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/nowait-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90
new file mode 100644
index 00000000000..99c097f1dad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90
new file mode 100644
index 00000000000..c4169bc55d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90
new file mode 100644
index 00000000000..37ce1c8b7b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-2a.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90
new file mode 100644
index 00000000000..ebf1f136180
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction-task-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90
index 61d89259c48..f91c7fae09d 100644
--- a/gcc/testsuite/gfortran.dg/gomp/scan-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/scan-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/scope-1.f90 b/gcc/testsuite/gfortran.dg/gomp/scope-1.f90
new file mode 100644
index 00000000000..43ec8007df7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scope-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/scope-2.f90 b/gcc/testsuite/gfortran.dg/gomp/scope-2.f90
new file mode 100644
index 00000000000..a097ced86ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/scope-2.f90
@@ -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
diff --git a/libgomp/testsuite/libgomp.fortran/scope-1.f90 b/libgomp/testsuite/libgomp.fortran/scope-1.f90
new file mode 100644
index 00000000000..3f41e894131
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/scope-1.f90
@@ -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
diff --git a/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90 b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
new file mode 100644
index 00000000000..c6b39e0b391
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
@@ -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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-08-17 13:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-17 13:51 [gcc r12-2962] Fortran: Implement OpenMP 5.1 scope construct Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).