diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 30631abd788..b7429e39a5b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2232,6 +2232,9 @@ typedef struct gfc_namespace
   /* OpenMP requires. */
   unsigned omp_requires:6;
   unsigned omp_target_seen:1;
+
+  /* Set to 1 if this is an implicit OMP structured block.  */
+  unsigned omp_structured_block:1;
 }
 gfc_namespace;
 
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 8efc4b3ecfa..e0d88dca41b 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -30,6 +30,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gomp-constants.h"
 #include "target-memory.h"  /* For gfc_encode_character.  */
 #include "bitmap.h"
+#include "omp-api.h"  /* For omp_runtime_api_procname.  */
 
 
 static gfc_statement omp_code_to_statement (gfc_code *);
@@ -7499,15 +7500,24 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	  gfc_error ("Object %qs is not a variable at %L", n->sym->name,
 		     &n->where);
       }
-  if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]
-      && code->op != EXEC_OMP_DO
-      && code->op != EXEC_OMP_SIMD
-      && code->op != EXEC_OMP_DO_SIMD
-      && code->op != EXEC_OMP_PARALLEL_DO
-      && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
-    gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, SIMD, "
-	       "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
-	       &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where);
+  if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+    {
+      locus *loc = &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
+      if (code->op != EXEC_OMP_DO
+	  && code->op != EXEC_OMP_SIMD
+	  && code->op != EXEC_OMP_DO_SIMD
+	  && code->op != EXEC_OMP_PARALLEL_DO
+	  && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
+	gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, "
+		   "SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
+		   loc);
+      if (omp_clauses->ordered)
+	gfc_error ("ORDERED clause specified together with %<inscan%> "
+		   "REDUCTION clause at %L", loc);
+      if (omp_clauses->sched_kind != OMP_SCHED_NONE)
+	gfc_error ("SCHEDULE clause specified together with %<inscan%> "
+		   "REDUCTION clause at %L", loc);
+    }
 
   for (list = 0; list < OMP_LIST_NUM; list++)
     if (list != OMP_LIST_FIRSTPRIVATE
@@ -9398,68 +9408,114 @@ static struct fortran_omp_context
 static gfc_code *omp_current_do_code;
 static int omp_current_do_collapse;
 
+/* Forward declaration for mutually recursive functions.  */
+static gfc_code *
+find_nested_loop_in_block (gfc_code *block);
+
+/* Return the first nested DO loop in CHAIN, or NULL if there
+   isn't one.  Does no error checking on intervening code.  */
+
+static gfc_code *
+find_nested_loop_in_chain (gfc_code *chain)
+{
+  gfc_code *code;
+
+  if (!chain)
+    return NULL;
+
+  for (code = chain; code; code = code->next)
+    {
+      if (code->op == EXEC_DO)
+	return code;
+      else if (code->op == EXEC_BLOCK)
+	{
+	  gfc_code *c = find_nested_loop_in_block (code);
+	  if (c)
+	    return c;
+	}
+    }
+  return NULL;
+}
+
+/* Return the first nested DO loop in BLOCK, or NULL if there
+   isn't one.  Does no error checking on intervening code.  */
+static gfc_code *
+find_nested_loop_in_block (gfc_code *block)
+{
+  gfc_namespace *ns;
+  gcc_assert (block->op == EXEC_BLOCK);
+  ns = block->ext.block.ns;
+  gcc_assert (ns);
+  return find_nested_loop_in_chain (ns->code);
+}
+
 void
 gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
 {
   if (code->block->next && code->block->next->op == EXEC_DO)
     {
       int i;
-      gfc_code *c;
 
       omp_current_do_code = code->block->next;
       if (code->ext.omp_clauses->orderedc)
 	omp_current_do_collapse = code->ext.omp_clauses->orderedc;
-      else
+      else if (code->ext.omp_clauses->collapse)
 	omp_current_do_collapse = code->ext.omp_clauses->collapse;
-      for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
-	{
-	  c = c->block;
-	  if (c->op != EXEC_DO || c->next == NULL)
-	    break;
-	  c = c->next;
-	  if (c->op != EXEC_DO)
-	    break;
-	}
-      if (i < omp_current_do_collapse || omp_current_do_collapse <= 0)
+      else
 	omp_current_do_collapse = 1;
       if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
 	{
+	  /* Checking that there is a matching EXEC_OMP_SCAN in the
+	     innermost body cannot be deferred to resolve_omp_do because
+	     we process directives nested in the loop before we get
+	     there.  */
 	  locus *loc
 	    = &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
-	  if (code->ext.omp_clauses->ordered)
-	    gfc_error ("ORDERED clause specified together with %<inscan%> "
-		       "REDUCTION clause at %L", loc);
-	  if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE)
-	    gfc_error ("SCHEDULE clause specified together with %<inscan%> "
-		       "REDUCTION clause at %L", loc);
-	  gfc_code *block = c->block ? c->block->next : NULL;
-	  if (block && block->op != EXEC_OMP_SCAN)
-	    while (block && block->next && block->next->op != EXEC_OMP_SCAN)
-	      block = block->next;
-	  if (!block
-	      || (block->op != EXEC_OMP_SCAN
-		  && (!block->next || block->next->op != EXEC_OMP_SCAN)))
-	    gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN "
-		       "between two structured block sequences", loc);
-	  else
+	  gfc_code *c;
+
+	  for (i = 1, c = omp_current_do_code;
+	       i < omp_current_do_collapse; i++)
 	    {
-	      if (block->op == EXEC_OMP_SCAN)
-		gfc_warning (0, "!$OMP SCAN at %L with zero executable "
-				"statements in preceding structured block "
-				"sequence", &block->loc);
-	      if ((block->op == EXEC_OMP_SCAN && !block->next)
-		  || (block->next && block->next->op == EXEC_OMP_SCAN
-		      && !block->next->next))
-		gfc_warning (0, "!$OMP SCAN at %L with zero executable "
-				"statements in succeeding structured block "
-				"sequence", block->op == EXEC_OMP_SCAN
-					    ? &block->loc : &block->next->loc);
-	    }
-	  if (block && block->op != EXEC_OMP_SCAN)
-	    block = block->next;
-	  if (block && block->op == EXEC_OMP_SCAN)
-	    /* Mark 'omp scan' as checked; flag will be unset later.  */
-	    block->ext.omp_clauses->if_present = true;
+	      c = find_nested_loop_in_chain (c->block->next);
+	      if (!c || c->op != EXEC_DO || c->block == NULL)
+		break;
+	    }
+
+	  /* Skip this if we don't have enough nested loops.  That
+	     problem will be diagnosed elsewhere.  */
+	  if (c && c->op == EXEC_DO)
+	    {
+	      gfc_code *block = c->block ? c->block->next : NULL;
+	      if (block && block->op != EXEC_OMP_SCAN)
+		while (block && block->next
+		       && block->next->op != EXEC_OMP_SCAN)
+		  block = block->next;
+	      if (!block
+		  || (block->op != EXEC_OMP_SCAN
+		      && (!block->next || block->next->op != EXEC_OMP_SCAN)))
+		gfc_error ("With INSCAN at %L, expected loop body with "
+			   "!$OMP SCAN between two "
+			   "structured block sequences", loc);
+	      else
+		{
+		  if (block->op == EXEC_OMP_SCAN)
+		    gfc_warning (0, "!$OMP SCAN at %L with zero executable "
+				 "statements in preceding structured block "
+				 "sequence", &block->loc);
+		  if ((block->op == EXEC_OMP_SCAN && !block->next)
+		      || (block->next && block->next->op == EXEC_OMP_SCAN
+			  && !block->next->next))
+		    gfc_warning (0, "!$OMP SCAN at %L with zero executable "
+				 "statements in succeeding structured block "
+				 "sequence", block->op == EXEC_OMP_SCAN
+				 ? &block->loc : &block->next->loc);
+		}
+	      if (block && block->op != EXEC_OMP_SCAN)
+		block = block->next;
+	      if (block && block->op == EXEC_OMP_SCAN)
+		/* Mark 'omp scan' as checked; flag will be unset later.  */
+		block->ext.omp_clauses->if_present = true;
+	    }
 	}
     }
   gfc_resolve_blocks (code->block, ns);
@@ -9589,13 +9645,12 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
      private just in the !$omp do resp. !$omp parallel do construct,
      with no implications for the outer parallel constructs.  */
 
-  while (i-- >= 1)
+  while (i-- >= 1 && c)
     {
       if (code == c)
 	return;
-
-      c = c->block->next;
-    }
+      c = find_nested_loop_in_chain (c->block->next);
+   }
 
   /* An openacc context may represent a data clause.  Abort if so.  */
   if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code))
@@ -9634,20 +9689,464 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns)
     gfc_traverse_ns (ns, handle_local_var);
 }
 
+
+/* Error checking on intervening code uses a code walker.  */
+
+struct icode_error_state
+{
+  const char *name;
+  bool errorp;
+  gfc_code *nested;
+  gfc_code *next;
+};
+
+static int
+icode_code_error_callback (gfc_code **codep,
+			   int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque)
+{
+  gfc_code *code = *codep;
+  icode_error_state *state = (icode_error_state *)opaque;
+
+  /* gfc_code_walker walks down CODE's next chain as well as
+     walking things that are actually nested in CODE.  We need to
+     special-case traversal of outer blocks, so stop immediately if we
+     are heading down such a next chain.  */
+  if (code == state->next)
+    return 1;
+
+  switch (code->op)
+    {
+    case EXEC_DO:
+    case EXEC_DO_WHILE:
+    case EXEC_DO_CONCURRENT:
+      gfc_error ("%s cannot contain loop in intervening code at %L",
+		 state->name, &code->loc);
+      state->errorp = true;
+      break;
+    case EXEC_CYCLE:
+    case EXEC_EXIT:
+      /* Errors have already been diagnosed in match_exit_cycle.  */
+      state->errorp = true;
+      break;
+    case EXEC_OMP_CRITICAL:
+    case EXEC_OMP_DO:
+    case EXEC_OMP_FLUSH:
+    case EXEC_OMP_MASTER:
+    case EXEC_OMP_ORDERED:
+    case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_DO:
+    case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+    case EXEC_OMP_SECTIONS:
+    case EXEC_OMP_SINGLE:
+    case EXEC_OMP_WORKSHARE:
+    case EXEC_OMP_ATOMIC:
+    case EXEC_OMP_BARRIER:
+    case EXEC_OMP_END_NOWAIT:
+    case EXEC_OMP_END_SINGLE:
+    case EXEC_OMP_TASK:
+    case EXEC_OMP_TASKWAIT:
+    case EXEC_OMP_TASKYIELD:
+    case EXEC_OMP_CANCEL:
+    case EXEC_OMP_CANCELLATION_POINT:
+    case EXEC_OMP_TASKGROUP:
+    case EXEC_OMP_SIMD:
+    case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET:
+    case EXEC_OMP_TARGET_DATA:
+    case EXEC_OMP_TEAMS:
+    case EXEC_OMP_DISTRIBUTE:
+    case EXEC_OMP_DISTRIBUTE_SIMD:
+    case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
+    case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_TEAMS:
+    case EXEC_OMP_TEAMS_DISTRIBUTE:
+    case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+    case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_UPDATE:
+    case EXEC_OMP_END_CRITICAL:
+    case EXEC_OMP_TARGET_ENTER_DATA:
+    case EXEC_OMP_TARGET_EXIT_DATA:
+    case EXEC_OMP_TARGET_PARALLEL:
+    case EXEC_OMP_TARGET_PARALLEL_DO:
+    case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_SIMD:
+    case EXEC_OMP_TASKLOOP:
+    case EXEC_OMP_TASKLOOP_SIMD:
+    case EXEC_OMP_SCAN:
+    case EXEC_OMP_DEPOBJ:
+    case EXEC_OMP_PARALLEL_MASTER:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_LOOP:
+    case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_TEAMS_LOOP:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
+    case EXEC_OMP_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+    case EXEC_OMP_SCOPE:
+    case EXEC_OMP_ERROR:
+      gfc_error ("%s cannot contain OpenMP directive in intervening code "
+		 "at %L",
+		 state->name, &code->loc);
+      state->errorp = true;
+      break;
+    case EXEC_CALL:
+      /* Per OpenMP 5.2, the "omp_" prefix is reserved, so we don't have to
+	 consider the possibility that some locally-bound definition
+	 overrides the runtime routine.  */
+      if (code->resolved_sym
+	  && omp_runtime_api_procname (code->resolved_sym->name))
+	{
+	  gfc_error ("%s cannot contain OpenMP API call in intervening code "
+		     "at %L",
+		 state->name, &code->loc);
+	  state->errorp = true;
+	}
+      break;
+    default:
+      break;
+    }
+  return 0;
+}
+
+static int
+icode_expr_error_callback (gfc_expr **expr,
+			   int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque)
+{
+  icode_error_state *state = (icode_error_state *)opaque;
+
+  switch ((*expr)->expr_type)
+    {
+      /* As for EXPR_CALL with "omp_"-prefixed symbols.  */
+    case EXPR_FUNCTION:
+      {
+	gfc_symbol *sym = (*expr)->value.function.esym;
+	if (sym && omp_runtime_api_procname (sym->name))
+	  {
+	    gfc_error ("%s cannot contain OpenMP API call in intervening code "
+		       "at %L",
+		       state->name, &((*expr)->where));
+	    state->errorp = true;
+	  }
+	}
+
+      break;
+    default:
+      break;
+    }
+
+  /* FIXME: The description of canonical loop form in the OpenMP standard
+     also says "array expressions" are not permitted in intervening code.
+     That term is not defined in either the OpenMP spec or the Fortran
+     standard, although the latter uses it informally to refer to any
+     expression that is not scalar-valued.  It is also apparently not the
+     thing GCC internally calls EXPR_ARRAY.  It seems the intent of the
+     OpenMP restriction is to disallow elemental operations/intrinsics
+     (including things that are not expressions, like assignment
+     statements) that generate implicit loops over array operands
+     (even if the result is a scalar), but even if the spec said
+     that there is no list of all the cases that would be forbidden.
+     This is OpenMP issue 3326.  */
+
+  return 0;
+}
+
+static void
+diagnose_intervening_code_errors_1 (gfc_code *chain,
+				    struct icode_error_state *state)
+{
+  gfc_code *code;
+  for (code = chain; code; code = code->next)
+    {
+      if (code == state->nested)
+	/* Do not walk the nested loop or its body, we are only
+	   interested in intervening code.  */
+	;
+      else if (code->op == EXEC_BLOCK
+	       && find_nested_loop_in_block (code) == state->nested)
+	/* This block contains the nested loop, recurse on its
+	   statements.  */
+	{
+	  gfc_namespace* ns = code->ext.block.ns;
+	  diagnose_intervening_code_errors_1 (ns->code, state);
+	}
+      else
+	/* Treat the whole statement as a unit.  */
+	{
+	  gfc_code *temp = state->next;
+	  state->next = code->next;
+	  gfc_code_walker (&code, icode_code_error_callback,
+			   icode_expr_error_callback, state);
+	  state->next = temp;
+	}
+    }
+}
+
+/* Diagnose intervening code errors in BLOCK with nested loop NESTED.
+   NAME is the user-friendly name of the OMP directive, used for error
+   messages.  Returns true if any error was found.  */
+static bool
+diagnose_intervening_code_errors (gfc_code *chain, const char *name,
+				  gfc_code *nested)
+{
+  struct icode_error_state state;
+  state.name = name;
+  state.errorp = false;
+  state.nested = nested;
+  state.next = NULL;
+  diagnose_intervening_code_errors_1 (chain, &state);
+  return state.errorp;
+}
+
+/* Helper function for restructure_intervening_code:  wrap CHAIN in
+   a marker to indicate that it is a structured block sequence.  That
+   information will be used later on (in omp-low.cc) for error checking.  */
+static gfc_code *
+make_structured_block (gfc_code *chain)
+{
+  gcc_assert (chain);
+  gfc_namespace *ns = gfc_build_block_ns (gfc_current_ns);
+  gfc_code *result = gfc_get_code (EXEC_BLOCK);
+  result->op = EXEC_BLOCK;
+  result->ext.block.ns = ns;
+  result->ext.block.assoc = NULL;
+  result->loc = chain->loc;
+  ns->omp_structured_block = 1;
+  ns->code = chain;
+  return result;
+}
+
+/* Push intervening code surrounding a loop, including nested scopes,
+   into the body of the loop.  CHAINP is the pointer to the head of
+   the next-chain to scan, OUTER_LOOP is the EXEC_DO for the next outer
+   loop level, and COLLAPSE is the number of nested loops we need to
+   process.
+   Note that CHAINP may point at outer_loop->block->next when we
+   are scanning the body of a loop, but if there is an intervening block
+   CHAINP points into the block's chain rather than its enclosing outer
+   loop.  This is why OUTER_LOOP is passed separately.  */
+static gfc_code *
+restructure_intervening_code (gfc_code **chainp, gfc_code *outer_loop,
+			      int count)
+{
+  gfc_code *code;
+  gfc_code *head = *chainp;
+  gfc_code *tail = NULL;
+  gfc_code *innermost_loop = NULL;
+
+  for (code = *chainp; code; code = code->next, chainp = &((*chainp)->next))
+    {
+      if (code->op == EXEC_DO)
+	{
+	  /* Cut CODE free from its chain, leaving the ends dangling.  */
+	  *chainp = NULL;
+	  tail = code->next;
+	  code->next = NULL;
+
+	  if (count == 1)
+	    innermost_loop = code;
+	  else
+	    innermost_loop
+	      = restructure_intervening_code (&(code->block->next),
+					      code, count - 1);
+	  break;
+	}
+      else if (code->op == EXEC_BLOCK
+	       && find_nested_loop_in_block (code))
+	{
+	  gfc_namespace *ns = code->ext.block.ns;
+
+	  /* Cut CODE free from its chain, leaving the ends dangling.  */
+	  *chainp = NULL;
+	  tail = code->next;
+	  code->next = NULL;
+
+	  innermost_loop
+	    = restructure_intervening_code (&(ns->code), outer_loop,
+					    count);
+
+	  /* At this point we have already pulled out the nested loop and
+	     pointed outer_loop at it, and moved the intervening code that
+	     was previously in the block into the body of innermost_loop.
+	     Now we want to move the BLOCK itself so it wraps the entire
+	     current body of innermost_loop.  */
+	  ns->code = innermost_loop->block->next;
+	  innermost_loop->block->next = code;
+	  break;
+	}
+    }
+
+  gcc_assert (innermost_loop);
+
+  /* Now we have split the intervening code into two parts:
+     head is the start of the part before the loop/block, terminating
+     at *chainp, and tail is the part after it.  Mark each part as
+     a structured block sequence, and splice the two parts around the
+     existing body of the innermost loop.  */
+  if (head != code)
+    {
+      gfc_code *block = make_structured_block (head);
+      if (innermost_loop->block->next)
+	gfc_append_code (block, innermost_loop->block->next);
+      innermost_loop->block->next = block;
+    }
+  if (tail)
+    {
+      gfc_code *block = make_structured_block (tail);
+      if (innermost_loop->block->next)
+	gfc_append_code (innermost_loop->block->next, block);
+      else
+	innermost_loop->block->next = block;
+    }
+
+  /* For loops, finally splice CODE into OUTER_LOOP.  We already handled
+     relinking EXEC_BLOCK above.  */
+  if (code->op == EXEC_DO && outer_loop)
+    outer_loop->block->next = code;
+
+  return innermost_loop;
+}
+
 /* CODE is an OMP loop construct.  Return true if VAR matches an iteration
    variable outer to level DEPTH.  */
 static bool
 is_outer_iteration_variable (gfc_code *code, int depth, gfc_symbol *var)
 {
   int i;
-  gfc_code *do_code = code->block->next;
+  gfc_code *do_code = code;
 
   for (i = 1; i < depth; i++)
     {
+      do_code = find_nested_loop_in_chain (do_code->block->next);
+      gcc_assert (do_code);
       gfc_symbol *ivar = do_code->ext.iterator->var->symtree->n.sym;
       if (var == ivar)
 	return true;
-      do_code = do_code->block->next;
+    }
+  return false;
+}
+
+/* Forward declaration for recursive functions.  */
+static gfc_code *
+check_nested_loop_in_block (gfc_code *block, gfc_expr *expr, gfc_symbol *sym,
+			    bool *bad);
+
+/* Like find_nested_loop_in_chain, but additionally check that EXPR
+   does not reference any variables bound in intervening EXEC_BLOCKs
+   and that SYM is not bound in such intervening blocks.  Either EXPR or SYM
+   may be null.  Sets *BAD to true if either test fails.  */
+static gfc_code *
+check_nested_loop_in_chain (gfc_code *chain, gfc_expr *expr, gfc_symbol *sym,
+			    bool *bad)
+{
+  for (gfc_code *code = chain; code; code = code->next)
+    {
+      if (code->op == EXEC_DO)
+	return code;
+      else if (code->op == EXEC_BLOCK)
+	{
+	  gfc_code *c = check_nested_loop_in_block (code, expr, sym, bad);
+	  if (c)
+	    return c;
+	}
+    }
+  return NULL;
+}
+
+/* Code walker for block symtrees.  It doesn't take any kind of state
+   argument, so use a static variable.  */
+static struct check_nested_loop_in_block_state_t {
+  gfc_expr *expr;
+  gfc_symbol *sym;
+  bool *bad;
+} check_nested_loop_in_block_state;
+
+static void
+check_nested_loop_in_block_symbol (gfc_symbol *sym)
+{
+  if (sym == check_nested_loop_in_block_state.sym
+      || (check_nested_loop_in_block_state.expr
+	  && gfc_find_sym_in_expr (sym,
+				   check_nested_loop_in_block_state.expr)))
+    *check_nested_loop_in_block_state.bad = true;
+}
+
+/* Return the first nested DO loop in BLOCK, or NULL if there
+   isn't one.  Set *BAD to true if EXPR references any variables in BLOCK, or
+   SYM is bound in BLOCK.  Either EXPR or SYM may be null.  */
+static gfc_code *
+check_nested_loop_in_block (gfc_code *block, gfc_expr *expr,
+			    gfc_symbol *sym, bool *bad)
+{
+  gfc_namespace *ns;
+  gcc_assert (block->op == EXEC_BLOCK);
+  ns = block->ext.block.ns;
+  gcc_assert (ns);
+
+  /* Skip the check if this block doesn't contain the nested loop, or
+     if we already know it's bad.  */
+  gfc_code *result = check_nested_loop_in_chain (ns->code, expr, sym, bad);
+  if (result && !*bad)
+    {
+      check_nested_loop_in_block_state.expr = expr;
+      check_nested_loop_in_block_state.sym = sym;
+      check_nested_loop_in_block_state.bad = bad;
+      gfc_traverse_ns (ns, check_nested_loop_in_block_symbol);
+      check_nested_loop_in_block_state.expr = NULL;
+      check_nested_loop_in_block_state.sym = NULL;
+      check_nested_loop_in_block_state.bad = NULL;
+    }
+  return result;
+}
+
+/* CODE is an OMP loop construct.  Return true if EXPR references
+   any variables bound in intervening code, to level DEPTH.  */
+static bool
+expr_uses_intervening_var (gfc_code *code, int depth, gfc_expr *expr)
+{
+  int i;
+  gfc_code *do_code = code;
+
+  for (i = 0; i < depth; i++)
+    {
+      bool bad = false;
+      do_code = check_nested_loop_in_chain (do_code->block->next,
+					    expr, NULL, &bad);
+      if (bad)
+	return true;
+    }
+  return false;
+}
+
+/* CODE is an OMP loop construct.  Return true if SYM is bound in
+   intervening code, to level DEPTH.  */
+static bool
+is_intervening_var (gfc_code *code, int depth, gfc_symbol *sym)
+{
+  int i;
+  gfc_code *do_code = code;
+
+  for (i = 0; i < depth; i++)
+    {
+      bool bad = false;
+      do_code = check_nested_loop_in_chain (do_code->block->next,
+					    NULL, sym, &bad);
+      if (bad)
+	return true;
     }
   return false;
 }
@@ -9658,14 +10157,15 @@ static bool
 expr_is_invariant (gfc_code *code, int depth, gfc_expr *expr)
 {
   int i;
-  gfc_code *do_code = code->block->next;
+  gfc_code *do_code = code;
 
   for (i = 1; i < depth; i++)
     {
+      do_code = find_nested_loop_in_chain (do_code->block->next);
+      gcc_assert (do_code);
       gfc_symbol *ivar = do_code->ext.iterator->var->symtree->n.sym;
       if (gfc_find_sym_in_expr (ivar, expr))
 	return false;
-      do_code = do_code->block->next;
     }
   return true;
 }
@@ -9736,12 +10236,14 @@ bound_expr_is_canonical (gfc_code *code, int depth, gfc_expr *expr,
 static void
 resolve_omp_do (gfc_code *code)
 {
-  gfc_code *do_code, *c;
-  int list, i, collapse;
+  gfc_code *do_code, *next;
+  int list, i, count;
   gfc_omp_namelist *n;
   gfc_symbol *dovar;
   const char *name;
   bool is_simd = false;
+  bool errorp = false;
+  bool perfect_nesting_errorp = false;
 
   switch (code->op)
     {
@@ -9844,12 +10346,12 @@ resolve_omp_do (gfc_code *code)
 
   do_code = code->block->next;
   if (code->ext.omp_clauses->orderedc)
-    collapse = code->ext.omp_clauses->orderedc;
+    count = code->ext.omp_clauses->orderedc;
   else
     {
-      collapse = code->ext.omp_clauses->collapse;
-      if (collapse <= 0)
-	collapse = 1;
+      count = code->ext.omp_clauses->collapse;
+      if (count <= 0)
+	count = 1;
     }
 
   /* While the spec defines the loop nest depth independently of the COLLAPSE
@@ -9857,29 +10359,36 @@ resolve_omp_do (gfc_code *code)
      depth and treats any further inner loops as the final-loop-body.  So
      here we also check canonical loop nest form only for the number of
      outer loops specified by the COLLAPSE clause too.  */
-  for (i = 1; i <= collapse; i++)
+  for (i = 1; i <= count; i++)
     {
       gfc_symbol *start_var = NULL, *end_var = NULL;
+      /* Parse errors are not recoverable.  */
       if (do_code->op == EXEC_DO_WHILE)
 	{
 	  gfc_error ("%s cannot be a DO WHILE or DO without loop control "
 		     "at %L", name, &do_code->loc);
-	  break;
+	  return;
 	}
       if (do_code->op == EXEC_DO_CONCURRENT)
 	{
 	  gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name,
 		     &do_code->loc);
-	  break;
+	  return;
 	}
       gcc_assert (do_code->op == EXEC_DO);
       if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
-	gfc_error ("%s iteration variable must be of type integer at %L",
-		   name, &do_code->loc);
+	{
+	  gfc_error ("%s iteration variable must be of type integer at %L",
+		     name, &do_code->loc);
+	  errorp = true;
+	}
       dovar = do_code->ext.iterator->var->symtree->n.sym;
       if (dovar->attr.threadprivate)
-	gfc_error ("%s iteration variable must not be THREADPRIVATE "
-		   "at %L", name, &do_code->loc);
+	{
+	  gfc_error ("%s iteration variable must not be THREADPRIVATE "
+		     "at %L", name, &do_code->loc);
+	  errorp = true;
+	}
       if (code->ext.omp_clauses)
 	for (list = 0; list < OMP_LIST_NUM; list++)
 	  if (!is_simd || code->ext.omp_clauses->collapse > 1
@@ -9898,13 +10407,20 @@ resolve_omp_do (gfc_code *code)
 		    gfc_error ("%s iteration variable present on clause "
 			       "other than PRIVATE, LASTPRIVATE, ALLOCATE or "
 			       "LINEAR at %L", name, &do_code->loc);
-		  break;
+		  errorp = true;
 		}
       if (is_outer_iteration_variable (code, i, dovar))
 	{
 	  gfc_error ("%s iteration variable used in more than one loop at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
+	}
+      else if (is_intervening_var (code, i, dovar))
+	{
+	  gfc_error ("%s iteration variable at %L is bound in "
+		     "intervening code",
+		     name, &do_code->loc);
+	  errorp = true;
 	}
       else if (!bound_expr_is_canonical (code, i,
 					 do_code->ext.iterator->start,
@@ -9912,7 +10428,15 @@ resolve_omp_do (gfc_code *code)
 	{
 	  gfc_error ("%s loop start expression not in canonical form at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
+	}
+      else if (expr_uses_intervening_var (code, i,
+					  do_code->ext.iterator->start))
+	{
+	  gfc_error ("%s loop start expression at %L uses variable bound in "
+		     "intervening code",
+		     name, &do_code->loc);
+	  errorp = true;
 	}
       else if (!bound_expr_is_canonical (code, i,
 					 do_code->ext.iterator->end,
@@ -9920,48 +10444,89 @@ resolve_omp_do (gfc_code *code)
 	{
 	  gfc_error ("%s loop end expression not in canonical form at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
+	}
+      else if (expr_uses_intervening_var (code, i,
+					  do_code->ext.iterator->end))
+	{
+	  gfc_error ("%s loop end expression at %L uses variable bound in "
+		     "intervening code",
+		     name, &do_code->loc);
+	  errorp = true;
 	}
       else if (start_var && end_var && start_var != end_var)
 	{
 	  gfc_error ("%s loop bounds reference different "
 		     "iteration variables at %L", name, &do_code->loc);
-	  break;
+	  errorp = true;
 	}
       else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
 	{
 	  gfc_error ("%s loop increment not in canonical form at %L",
 		     name, &do_code->loc);
-	  break;
+	  errorp = true;
+	}
+      else if (expr_uses_intervening_var (code, i,
+					  do_code->ext.iterator->step))
+	{
+	  gfc_error ("%s loop increment expression at %L uses variable "
+		     "bound in intervening code",
+		     name, &do_code->loc);
+	  errorp = true;
 	}
       if (start_var || end_var)
 	code->ext.omp_clauses->non_rectangular = 1;
 
-      for (c = do_code->next; c; c = c->next)
-	if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
-	  {
-	    gfc_error ("collapsed %s loops not perfectly nested at %L",
-		       name, &c->loc);
-	    break;
-	  }
-      if (i == collapse || c)
+      /* Only parse loop body into nested loop and intervening code if
+	 there are supposed to be more loops in the nest to collapse.  */
+      if (i == count)
 	break;
-      do_code = do_code->block;
-      if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+
+      next = find_nested_loop_in_chain (do_code->block->next);
+
+      if (!next)
 	{
-	  gfc_error ("not enough DO loops for collapsed %s at %L",
-		     name, &code->loc);
-	  break;
+	  /* Parse error, can't recover from this.  */
+	  gfc_error ("not enough DO loops for collapsed %s (level %d) at %L",
+		     name, i, &code->loc);
+	  return;
 	}
-      do_code = do_code->next;
-      if (do_code == NULL
-	  || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+      else if (next != do_code->block->next || next->next)
+	/* Imperfectly nested loop found.  */
 	{
-	  gfc_error ("not enough DO loops for collapsed %s at %L",
-		     name, &code->loc);
-	  break;
+	  /* Only diagnose violation of imperfect nesting constraints once.  */
+	  if (!perfect_nesting_errorp)
+	    {
+	      if (code->ext.omp_clauses->orderedc)
+		{
+		  gfc_error ("%s inner loops must be perfectly nested with "
+			     "ORDERED clause at %L",
+			     name, &code->loc);
+		  perfect_nesting_errorp = true;
+		}
+	      else if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+		{
+		  gfc_error ("%s inner loops must be perfectly nested with "
+			     "REDUCTION INSCAN clause at %L",
+			     name, &code->loc);
+		  perfect_nesting_errorp = true;
+		}
+	      /* FIXME: Also diagnose for TILE directives.  */
+	      if (perfect_nesting_errorp)
+		errorp = true;
+	    }
+	  if (diagnose_intervening_code_errors (do_code->block->next,
+						name, next))
+	    errorp = true;
 	}
+      do_code = next;
     }
+
+  /* Give up now if we found any constraint violations.  */
+  if (errorp)
+    return;
+
+  restructure_intervening_code (&(code->block->next), code, count);
 }
 
 
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7e768343a57..4b508003e32 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2334,6 +2334,7 @@ gfc_trans_block_construct (gfc_code* code)
   tree exit_label;
   stmtblock_t body;
   gfc_association_list *ass;
+  tree translated_body;
 
   ns = code->ext.block.ns;
   gcc_assert (ns);
@@ -2352,7 +2353,11 @@ gfc_trans_block_construct (gfc_code* code)
 
   finish_oacc_declare (ns, sym, true);
 
-  gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
+  translated_body = gfc_trans_code (ns->code);
+  if (ns->omp_structured_block)
+    translated_body = build1 (OMP_STRUCTURED_BLOCK, void_type_node,
+			      translated_body);
+  gfc_add_expr_to_block (&body, translated_body);
   gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
 
   /* Finish everything.  */
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index 77b2bdd7fcb..613f06f6ea9 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -31,11 +31,11 @@ subroutine collapse1
     do i = 1, 3
       do j = 4, 6
       end do
-      k = 4  ! { dg-error "loops not perfectly nested" }
+      k = 4
     end do
-  !$omp parallel do collapse(2)
+  !$omp parallel do collapse(2) ! { dg-error "not enough DO loops" }
     do i = 1, 3
-      do			! { dg-error "cannot be a DO WHILE or DO without loop control" }
+      do
       end do
     end do
   !$omp parallel do collapse(2)
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
index 1ab934e3d0d..9af3b656829 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
@@ -6,24 +6,24 @@ program p
       do j = 1, 8
         do k = 1, 8
         end do
-        x = 5  ! { dg-error "loops not perfectly nested" }
+        x = 5
       end do
    end do
-   !$omp parallel do ordered(3)
+   !$omp parallel do ordered(3) ! { dg-error "inner loops must be perfectly nested" }
    do i = 1, 8
       do j = 1, 8
         do k = 1, 8
         end do
       end do
-      x = 5  ! { dg-error "loops not perfectly nested" }
+      x = 5
    end do
-   !$omp parallel do collapse(2)  ! { dg-error "not enough DO loops for collapsed" }
+   !$omp parallel do collapse(2)
    do i = 1, 8
       x = 5
       do j = 1, 8
       end do
    end do
-   !$omp parallel do ordered(2)  ! { dg-error "not enough DO loops for collapsed" }
+   !$omp parallel do ordered(2) ! { dg-error "inner loops must be perfectly nested" }
    do i = 1, 8
       x = 5
       do j = 1, 8
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect-gotos.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect-gotos.f90
new file mode 100644
index 00000000000..e184ffe631e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect-gotos.f90
@@ -0,0 +1,69 @@
+! This test case is expected to fail due to errors.
+
+! These jumps are all OK since they are to/from the same structured block.
+subroutine f1 ()
+  integer :: i, j
+  !$omp do collapse(2) 
+  do i = 1, 64
+    go to 10
+10  continue
+    do j = 1, 64
+      go to 11
+11    continue
+    end do
+    go to 12
+12  continue    
+  end do
+end subroutine
+
+! Jump around loop body to/from different structured blocks of intervening
+! code.
+subroutine f2 ()
+  integer :: i, j
+  !$omp do collapse(2) 
+  do i = 1, 64
+    go to 20
+20  continue
+    if (i > 16) go to 22 ! { dg-error "invalid branch to/from OpenMP structured block" }
+    do j = 1, 64
+      go to 21
+21    continue
+    end do
+    go to 22
+22  continue    
+  end do
+end subroutine
+
+! Jump into loop body from intervening code.
+subroutine f3 ()
+  integer :: i, j
+  !$omp do collapse(2) 
+  do i = 1, 64
+    go to 30
+30  continue
+    if (i > 16) go to 31 ! { dg-error "invalid branch to/from OpenMP structured block" }
+    ! { dg-warning "Legacy Extension:" "" { target *-*-* } .-1 }
+    do j = 1, 64
+      go to 31
+31    continue  ! { dg-warning "Legacy Extension:" }
+    end do
+    go to 32
+32  continue    
+  end do
+end subroutine
+
+! Jump out of loop body to intervening code.
+subroutine f4 ()
+  integer :: i, j
+  !$omp do collapse(2) 
+  do i = 1, 64
+    go to 40
+40  continue
+    do j = 1, 64
+      if (i > 16) go to 41 ! { dg-error "invalid branch to/from OpenMP structured block" }
+    end do
+41  continue
+    go to 42
+42  continue    
+  end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect-invalid-scope.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect-invalid-scope.f90
new file mode 100644
index 00000000000..7cc60944131
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect-invalid-scope.f90
@@ -0,0 +1,81 @@
+! Test that various errors involving references to variables bound
+! in intervening code in the DO loop control expressions are diagnosed.
+
+subroutine foo (x, y)
+  integer :: x, y
+end subroutine
+
+subroutine f1 ()
+  integer :: i, j
+
+  !$omp do collapse (2)
+  do i = 1, 64
+    block
+      integer :: v
+      v = (i + 4) * 2
+      do j = v, 64  ! { dg-error "loop start expression at .1. uses variable bound in intervening code" }
+        call foo (i, j)
+      end do
+    end block
+  end do
+end subroutine
+
+subroutine f2 ()
+  integer :: i, j
+
+  !$omp do collapse (2)
+  do i = 1, 64
+    block
+      integer :: v
+      v = (i + 4) * 2
+      do j = 1, v  ! { dg-error "loop end expression at .1. uses variable bound in intervening code" }
+        call foo (i, j)
+      end do
+    end block
+  end do
+end subroutine
+
+subroutine f3 ()
+  integer :: i, j
+
+  !$omp do collapse (2)
+  do i = 1, 64
+    block
+      integer :: v
+      v = (i + 4) * 2
+      do j = 1, 64, v  ! { dg-error "loop increment expression at .1. uses variable bound in intervening code" }
+        call foo (i, j)
+      end do
+    end block
+  end do
+end subroutine
+
+subroutine f4 ()
+  integer :: i
+
+  !$omp do collapse (2)
+  do i = 1, 64
+    block
+      integer :: j
+      do j = 1, 64  ! { dg-error "iteration variable at .1. is bound in intervening code" }
+        call foo (i, j)
+      end do
+    end block
+  end do
+end subroutine
+
+subroutine f5 ()
+  integer :: i
+
+  !$omp do collapse (2)
+  do i = 1, 64
+    block
+      integer :: j
+      integer :: v
+      v = (i + 4) * 2
+      do j = v, 64  ! { dg-error "iteration variable at .1. is bound in intervening code" }
+        call foo (i, j)
+      end do
+    end block
+  end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
new file mode 100644
index 00000000000..4e750d9ad05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
@@ -0,0 +1,39 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3) 
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      if (i == 3) then
+        cycle  ! { dg-error "CYCLE statement" }
+      else
+        exit   ! { dg-error "EXIT statement" }
+      endif
+!$omp barrier  ! { dg-error "OpenMP directive in intervening code" }
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    do k = 1, a3  ! { dg-error "loop in intervening code" }
+      call f1 (3, k)
+      call f2 (3, k)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
new file mode 100644
index 00000000000..d02191050d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
@@ -0,0 +1,56 @@
+! This test case is expected to fail due to errors.
+
+! Note that the calls to these functions in the test case don't make
+! any sense in terms of behavior, they're just there to test the error
+! behavior.
+
+module omp_lib
+ use iso_c_binding
+  interface
+     integer function omp_get_thread_num ()
+     end
+     subroutine omp_set_max_levels (i)
+       integer :: i
+     end
+  end interface
+end module
+
+program junk
+  use omp_lib
+  implicit none
+  
+contains
+	 
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  integer :: m
+
+  !$omp do collapse(3) 
+  do i = 1, a1
+    call f1 (1, i)
+    m = omp_get_thread_num ()  ! { dg-error "OpenMP API call in intervening code" }
+    do j = 1, a2 + omp_get_thread_num ()  ! This is OK
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (m, k)
+	call omp_set_max_active_levels (k)  ! This is OK too
+        call f2 (m, k)
+      end do
+      call f2 (2, j)
+    call omp_set_max_active_levels (i)  ! { dg-error "OpenMP API call in intervening code" }
+    end do
+    call f2 (1, i)
+  end do
+end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
new file mode 100644
index 00000000000..2eccdfc8b58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
@@ -0,0 +1,29 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do ordered(3)     ! { dg-error "inner loops must be perfectly nested" }
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
new file mode 100644
index 00000000000..b7ccd8b6c53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
@@ -0,0 +1,36 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+! Unlike the C/C++ front ends, the Fortran front end already has the whole
+! parse tree for the OMP DO construct before doing error checking on it.
+! It gives up immediately if there are not enough nested loops for the
+! specified COLLAPSE depth, without error-checking intervening code.
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(4)     ! { dg-error "not enough DO loops" }
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+! This is not valid intervening code, but the above error takes precedence.
+!$omp barrier
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
new file mode 100644
index 00000000000..95cc7f144a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
@@ -0,0 +1,67 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+end subroutine
+
+function ijk (x, y, z)
+  integer :: ijk
+  integer :: x, y, z
+end function
+
+subroutine f3 (sum)
+  integer :: sum
+end subroutine  
+
+! This function isn't particularly meaningful, but it should compile without
+!  error.
+function s1 (a1, a2, a3)
+  integer :: s1
+  integer :: a1, a2, a3
+  integer :: i, j, k
+  integer :: r
+  
+  r = 0
+  !$omp simd collapse(3) reduction (inscan, +:r)
+  do i = 1, a1
+    do j = 1, a2
+      do k = 1, a3
+        r = r + ijk (i, j, k)
+!$omp scan exclusive (r)
+        call f3 (r)
+      end do
+    end do
+  end do
+
+  s1 = r
+end function
+
+! Adding intervening code should trigger an error.
+function s2 (a1, a2, a3)
+  integer :: s2
+  integer :: a1, a2, a3
+  integer :: i, j, k
+  integer :: r
+  
+  r = 0
+  !$omp simd collapse(3) reduction (inscan, +:r)     ! { dg-error "inner loops must be perfectly nested" }
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        r = r + ijk (i, j, k)
+!$omp scan exclusive (r)
+        call f3 (r)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+  
+  s2 = r
+end function
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
new file mode 100644
index 00000000000..664d27fe968
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
@@ -0,0 +1,142 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but adds bindings to the blocks.
+
+module m
+  implicit none
+  type t
+      integer :: i
+    contains
+      final :: fini
+  end type t
+
+  integer :: ccount(3), dcount(3)
+
+  contains
+
+    subroutine init(x, n)
+      type(t) :: x
+      integer :: n
+      x%i = n
+      ccount(x%i) = ccount(x%i) + 1
+    end subroutine init
+
+    subroutine fini(x)
+      type(t) :: x
+      dcount(x%i) = dcount(x%i) + 1
+    end subroutine fini
+end module m
+
+program foo
+  use m
+
+  integer :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+  ! Check that constructors and destructors are called equal number of times.
+  if (ccount(1) /= dcount(1)) error stop 141
+  if (ccount(2) /= dcount(2)) error stop 142
+  if (ccount(3) /= dcount(3)) error stop 143
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      type (t) :: local1
+      call init (local1, 1)
+      call g1 (local1%i, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  type (t) :: local2
+	  call init (local2, 2)
+          call g1 (local2%i, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      type (t) :: local3
+	      call init (local3, 3)
+              call g1 (local3%i, k)
+              call g2 (local3%i, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2%i, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1%i, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect1.f90
new file mode 100644
index 00000000000..8c483c2a4e5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect1.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect2.f90
new file mode 100644
index 00000000000..e42cb08031b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect2.f90
@@ -0,0 +1,102 @@
+! { dg-do run }
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      call g1 (1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+          call g1 (2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/imperfect3.f90
new file mode 100644
index 00000000000..da094612332
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect3.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but adds bindings to the blocks.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      integer :: local1
+      local1 = 1
+      call g1 (local1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  integer :: local2
+	  local2 = 2
+          call g1 (local2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      integer :: local3
+	      local3 = 3
+              call g1 (local3, k)
+              call g2 (local3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
new file mode 100644
index 00000000000..1679c8c5b92
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
@@ -0,0 +1,121 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but includes blocks that are themselves wholly
+! intervening code and not containers for nested loops.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    block
+      call f1 (1, i)
+    end block
+    block
+      block
+        call g1 (1, i)
+      end block
+      do j = 1, a2
+        block
+          call f1 (2, j)
+        end block
+        block
+          block
+            call g1 (2, j)
+          end block
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          block
+            call g2 (2, j)
+          end block
+        end block
+        block
+          call f2 (2, j)
+        end block
+      end do
+      block
+        call g2 (1, i)
+      end block
+    end block
+    block
+      call f2 (1, i)
+    end block
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
new file mode 100644
index 00000000000..608eee7e424
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+  !$omp declare target enter (f1count, f2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
new file mode 100644
index 00000000000..982661c278a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      call g1 (1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+          call g1 (2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
new file mode 100644
index 00000000000..6f4f92d6f3f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
@@ -0,0 +1,116 @@
+! { dg-do run }
+
+! Like imperfect3.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      integer :: local1
+      local1 = 1
+      call g1 (local1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  integer :: local2
+	  local2 = 2
+          call g1 (local2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      integer :: local3
+	      local3 = 3
+              call g1 (local3, k)
+              call g2 (local3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
new file mode 100644
index 00000000000..59ec0e92b05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
@@ -0,0 +1,126 @@
+! { dg-do run }
+
+! Like imperfect4.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    block
+      call f1 (1, i)
+    end block
+    block
+      block
+        call g1 (1, i)
+      end block
+      do j = 1, a2
+        block
+          call f1 (2, j)
+        end block
+        block
+          block
+            call g1 (2, j)
+          end block
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          block
+            call g2 (2, j)
+          end block
+        end block
+        block
+          call f2 (2, j)
+        end block
+      end do
+      block
+        call g2 (1, i)
+      end block
+    end block
+    block
+      call f2 (1, i)
+    end block
+  end do
+
+end subroutine
+
+end program
