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 --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 53c49fe4d6f9d8f731a8e76f99aa99bab020a3cd..92d9f9e054d7fac5db2cae3dd14baf6dba3fa57b 100644 (file)
--- 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 5fde4174a5bc9269c2af502c2a9bf651fb376c47..a7d82ae38c2c11be198b58088c870ad6b596bb13 100644 (file)
--- 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 dce650346d3b212f1378814149edef338089f0cf..aac16a8d3d0f2d931cb1c6fe958c23c210345d73 100644 (file)
--- 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 1bce43cb33ee25ff6589eb4da0bf948788b28043..9675b6584093bf8395ebe3475e9adab272eecae1 100644 (file)
--- 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 e1d78de5d9eeddbff8393778dac552037df5cf73..24cc9bfb9f1d7f3d60ea1b13b895db5248ebbf98 100644 (file)
--- 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 8eb8a9ab6d725c57ec7ac348fbd3d388230c0439..117062b48d8eb52b074e2749556f4b996df082dc 100644 (file)
--- 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 f61f88adcc5fdc29910181a521a0fb803b64ab36..7d87709d3872169992cf360d5c10437866b8c812 100644 (file)
--- 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 623c21fc790b53c6fa1fe09a05b3527c13a4be15..e0a001420e639e9b686b92d30011239907ab7169 100644 (file)
--- 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 ce5b2f8d594b5448fe62b7c4fef5230b16e26d4b..80b724d08390c3853467e18e0300cd9b290c63ce 100644 (file)
--- 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 (file)
index 0000000..d60dd72
--- /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 (file)
index 0000000..0fb814e
--- /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 (file)
index 0000000..7374589
--- /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 (file)
index 0000000..af4c2fb
--- /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 (file)
index 0000000..2eccdf9
--- /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 (file)
index 0000000..cd2e39a
--- /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 (file)
index 0000000..b47b4a1
--- /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 (file)
index 0000000..99c097f
--- /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 (file)
index 0000000..c4169bc
--- /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 (file)
index 0000000..37ce1c8
--- /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 (file)
index 0000000..ebf1f13
--- /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 61d89259c489003059dbf433388b75a8a1f0d8bf..f91c7fae09d3db126779ea07486d32d66e577735 100644 (file)
--- 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 (file)
index 0000000..43ec800
--- /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 (file)
index 0000000..a097ced
--- /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 (file)
index 0000000..3f41e89
--- /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 (file)
index 0000000..c6b39e0
--- /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