On 17.08.21 09:47, Jakub Jelinek wrote:
This patch implements the OpenMP 5.1 scope construct, which is similar
to worksharing constructs in many regards, but isn't one of them.
And the attached patch does the same for Fortran.
I took the opportunity to convert some additional C/C++ testcases to Fortran
ones.
That latter is rather mechanical but took surprisingly much longer than the
actual FE change. On the way, I improved the error message for
'omp end <token> junk' and 'omp cancellation <junk>'.
And I encountered one issue with the reductions and the 'task' modifier,
https://gcc.gnu.org/PR101948
Otherwise, the patch is straight forward and, hence, a bit boring.
Tobias
PS: I noted that
if (.false.) &
!$omp cancellation do
gives an error in C/C++ FE but not in the Fortran FE. With .true. it
reaches the ME and does give a ME error about an orphaned construct.
I did not fill a PR – but if someone thinks it should print an error,
feel free to open a PR.
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
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.
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..0ba7456b23b 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
