public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-11] Fortran: Implement OpenMP 5.1 scope construct
@ 2021-08-17 14:35 Tobias Burnus
  0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2021-08-17 14:35 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:f28b4b6b70d7251492839365dc1318e4c7174468

commit f28b4b6b70d7251492839365dc1318e4c7174468
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Tue Aug 17 15:56:41 2021 +0200

    Fortran: Implement OpenMP 5.1 scope construct
    
    Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f,
    which implemented OpenMP's scope construct for C and C++.
    Most testcases are based on the C testcases; it also contains some
    testcases which existed previously but had no Fortran equivalent.
    
    gcc/fortran/ChangeLog:
    
            * dump-parse-tree.c (show_omp_node, show_code_node): Handle
            EXEC_OMP_SCOPE.
            * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE.
            (enum gfc_exec_op): Add EXEC_OMP_SCOPE.
            * match.h (gfc_match_omp_scope): New.
            * openmp.c (OMP_SCOPE_CLAUSES): Define
            (gfc_match_omp_scope): New.
            (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait):
            Improve error diagnostic.
            (omp_code_to_statement): Handle ST_OMP_SCOPE.
            (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE.
            * parse.c (decode_omp_directive, next_statement,
            gfc_ascii_statement, parse_omp_structured_block,
            parse_executable): Handle OpenMP's scope construct.
            * resolve.c (gfc_resolve_blocks): Likewise
            * st.c (gfc_free_statement): Likewise
            * trans-openmp.c (gfc_trans_omp_scope): New.
            (gfc_trans_omp_directive): Call it.
            * trans.c (trans_code): handle EXEC_OMP_SCOPE.
    
    libgomp/ChangeLog:
    
            * testsuite/libgomp.fortran/scope-1.f90: New test.
            * testsuite/libgomp.fortran/task-reduction-16.f90: New test.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/gomp/scan-1.f90:
            * gfortran.dg/gomp/cancel-1.f90: New test.
            * gfortran.dg/gomp/cancel-4.f90: New test.
            * gfortran.dg/gomp/loop-4.f90: New test.
            * gfortran.dg/gomp/nesting-1.f90: New test.
            * gfortran.dg/gomp/nesting-2.f90: New test.
            * gfortran.dg/gomp/nesting-3.f90: New test.
            * gfortran.dg/gomp/nowait-1.f90: New test.
            * gfortran.dg/gomp/reduction-task-1.f90: New test.
            * gfortran.dg/gomp/reduction-task-2.f90: New test.
            * gfortran.dg/gomp/reduction-task-2a.f90: New test.
            * gfortran.dg/gomp/reduction-task-3.f90: New test.
            * gfortran.dg/gomp/scope-1.f90: New test.
            * gfortran.dg/gomp/scope-2.f90: New test.
    
    (cherry picked from commit f8d535f3fec81c1cc84e22df5500e693544ec65b)

Diff:
---
 gcc/fortran/ChangeLog.omp                          |  25 +
 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/ChangeLog.omp                        |  20 +
 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/ChangeLog.omp                              |   8 +
 libgomp/testsuite/libgomp.fortran/scope-1.f90      |  55 +++
 .../libgomp.fortran/task-reduction-16.f90          |  82 ++++
 28 files changed, 1964 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 8d36534e29f..53456078b65 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,28 @@
+2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	* 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.
+
 2021-08-16  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index cc24839643f..6a409efc027 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1975,6 +1975,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;
@@ -2058,6 +2059,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:
@@ -3286,6 +3288,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 c07f317a996..418b0728c05 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
@@ -2769,7 +2769,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 7767aedaaca..4cd95f56818 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3138,6 +3138,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)
@@ -4476,6 +4478,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)
 {
@@ -4964,7 +4973,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 "
@@ -4987,7 +5000,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;
@@ -7461,6 +7477,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:
@@ -7973,6 +7991,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 9cc822d00b5..c7cb590ae29 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -953,6 +953,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);
@@ -1054,6 +1055,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);
@@ -1674,7 +1676,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: \
@@ -2611,6 +2613,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;
@@ -5465,6 +5470,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;
@@ -5765,11 +5773,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 74641364c91..ea781cf9ec4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10832,6 +10832,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:
@@ -12255,6 +12256,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 5a073b6049b..21b8fd8c1f9 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -6301,6 +6301,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)
 {
@@ -7185,6 +7203,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 6fbb1209391..09b3dc45f1b 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2189,6 +2189,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 4b91bed4050..376a2a4c9da 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,23 @@
+2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	* 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.
+
 2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
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/ChangeLog.omp b/libgomp/ChangeLog.omp
index 95fc075377d..31540ddc1bc 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,11 @@
+2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	* testsuite/libgomp.fortran/scope-1.f90: New test.
+	* testsuite/libgomp.fortran/task-reduction-16.f90: New test.
+
 2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/libgomp/testsuite/libgomp.fortran/scope-1.f90 b/libgomp/testsuite/libgomp.fortran/scope-1.f90
new file mode 100644
index 00000000000..3f41e894131
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/scope-1.f90
@@ -0,0 +1,55 @@
+program main
+  implicit none (type, external)
+  integer :: r, r2, i
+  integer a(0:63)
+  a = 0
+  r = 0; r2 = 0
+  !$omp parallel
+    !$omp scope
+      !$omp scope
+        !$omp do
+          do i = 0, 63
+            a(i) = a(i) + 1
+          end do
+        !$omp end do
+      !$omp end scope nowait
+    !$omp end scope nowait
+
+    !$omp scope reduction(+: r)
+      !$omp do
+        do i = 0, 63
+          r = r + i
+          if (a(i) /= 1) &
+            stop 1
+        end do
+      !$omp end do nowait
+      !$omp barrier
+    !$omp end scope nowait
+
+    !$omp barrier
+
+    if (r /= 64 * 63 / 2) &
+      stop 2
+
+    !$omp scope private (i)
+      !$omp scope reduction(+: r2)
+        !$omp do
+          do i = 0, 63
+            r2 = r2 + 2 * i
+            a(i) = a(i) + i
+          end do
+        !$omp end do nowait
+      !$omp end scope
+    !$omp end scope nowait
+
+    if (r2 /= 64 * 63) &
+      stop 3
+
+    !$omp do
+      do i = 0, 63
+        if (a(i) /= i + 1) &
+          stop 4
+      end do
+    !$omp end do nowait
+  !$omp end parallel
+end
diff --git a/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90 b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
new file mode 100644
index 00000000000..c6b39e0b391
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
@@ -0,0 +1,82 @@
+module m
+  implicit none (external, type)
+  integer :: a, b(0:2) = [1, 1, 1]
+  integer(8) :: c(0:1) = [not(0_8), not(0_8)]
+contains
+  subroutine bar (i)
+    integer :: i
+    !$omp task in_reduction (*: b) in_reduction (iand: c) &
+    !$omp&     in_reduction (+: a)
+      a = a + 4
+      b(1) = b(1) * 4
+      c(1) = iand (c(1), not(ishft(1_8, i + 16)))
+    !$omp end task
+  end subroutine bar
+
+  subroutine foo (x)
+    integer :: x
+    !$omp scope reduction (task, +: a)
+      !$omp scope reduction (task, *: b)
+        !$omp scope reduction (task, iand: c)
+          !$omp barrier
+          !$omp sections
+            block
+              a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3
+              c(1) = iand(c(1), not(ishft(1_8, 2)))
+            end block
+            !$omp section
+            block
+              b(0) = b(0) * 2; call bar (4); b(2) = b(2) * 3
+              c(1) = iand(c(1), not(ishft(1_8, 4))); a = a + 1
+            end block
+            !$omp section
+            block
+              call bar (6); b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 6)))
+              a = a + 1; b(0) = b(0) * 2
+            end block
+            !$omp section
+            block
+              b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 8)))
+              a = a + 1; b(0) = b(0) * 2; call bar (8)
+            end block
+            !$omp section
+            block
+              c(1) = iand(c(1), not(ishft(1_8, 10))); a = a + 1
+              b(0) = b(0) * 2; call bar (10); b(2) = b(2) * 3
+            end block
+            !$omp section
+            block
+              a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
+              c(1) = iand(c(1), not(ishft(1_8, 12))); call bar (12)
+            end block
+            !$omp section
+              if (x /= 0) then
+                a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
+                call bar (14); c(1) = iand (c(1), not(ishft(1_8, 14)))
+              end if
+          !$omp end sections
+        !$omp end scope 
+      !$omp end scope 
+    !$omp end scope 
+  end subroutine foo
+end module m
+
+program main
+  use m
+  implicit none (type, external)
+  integer, volatile :: one
+  one = 1
+  call foo (0)
+  if (a /= 30 .or. b(0) /= 64 .or. b(1) /= ishft (1, 12) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 &
+      .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'15541554', kind=8))) &
+    stop 1
+  a = 0
+  b(:) = [1, 1, 1]
+  c(1) = not(0_8)
+  !$omp parallel
+    call foo (one)
+  !$omp end parallel
+  if (a /= 35 .or. b(0) /= 128 .or. b(1) /= ishft(1, 14) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 * 3 &
+      .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'55545554', kind=8))) &
+    stop 2
+end program main


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2021-08-17 14:35 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-17 14:35 [gcc/devel/omp/gcc-11] Fortran: Implement OpenMP 5.1 scope construct Tobias Burnus

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).