public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH 0/3] OpenMP: Support imperfectly-nested loops
@ 2023-04-28 23:22 Sandra Loosemore
  2023-04-28 23:22 ` [PATCH 1/3] OpenMP: C support for " Sandra Loosemore
                   ` (2 more replies)
  0 siblings, 3 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-04-28 23:22 UTC (permalink / raw)
  To: gcc-patches

OpenMP 5.0 removed the restriction that collapsed loops in "omp
for/do" and related constructs must be perfectly nested; it now allows
intervening code to appear before/after each nested loop level.  The
spec allows implementations considerable freedom in how many times this
intervening code is executed, and it seemed to me that the simplest
solution was to push it all into the loop body so that it is executed
on every logical iteration.  Implementing this in the respective front
ends means that no changes are required in the OMP_FOR representation
or in subsequent gimplification and lowering passes.

For C and C++, I refactored the OMP_FOR parsing code to use recursive
descent and parallel the revised syntax in the OpenMP spec for
canonical loop nest form.  In C this was relatively straightforward,
but in C++ the code that handles nested scopes for class iterators
gave me fits.  I ended up parsing the entire construct and then
reassembling the bits of code, and I tried to make this at least
better-documented than the code that was previously there.  In the
Fortran front end, I implemented the transformation during resolution.

This patch series has some overlap with Frederik Harwath's tile/unroll
patch set, but has been developed and tested independently of those changes.

https://gcc.gnu.org/pipermail/gcc-patches/2023-March/614564.html

Depending on what order they are reviewed/committed in, we will of
course take care of merging and retesting them together.  Frederik has
already reviewed my patches and gave me some very helpful feedback,
and Tobias also has helped out, especially when I got stuck on some
unrelated bugs.

-Sandra


Sandra Loosemore (3):
  OpenMP: C support for imperfectly-nested loops
  OpenMP: C++ support for imperfectly-nested loops
  OpenMP: Fortran support for imperfectly-nested loops

 gcc/c/c-parser.cc                             |  692 ++++++----
 gcc/cp/cp-tree.h                              |    2 +-
 gcc/cp/parser.cc                              | 1180 ++++++++++++-----
 gcc/cp/parser.h                               |    3 +
 gcc/cp/pt.cc                                  |    3 +-
 gcc/cp/semantics.cc                           |   80 +-
 gcc/fortran/openmp.cc                         |  590 +++++++--
 gcc/omp-api.h                                 |   32 +
 gcc/omp-general.cc                            |  134 ++
 gcc/omp-general.h                             |    1 +
 gcc/omp-low.cc                                |  129 --
 gcc/testsuite/c-c++-common/goacc/collapse-1.c |   14 +-
 gcc/testsuite/c-c++-common/goacc/tile-2.c     |    4 +-
 gcc/testsuite/c-c++-common/gomp/imperfect1.c  |   40 +
 gcc/testsuite/c-c++-common/gomp/imperfect2.c  |   36 +
 gcc/testsuite/c-c++-common/gomp/imperfect3.c  |   35 +
 gcc/testsuite/c-c++-common/gomp/imperfect4.c  |   35 +
 gcc/testsuite/c-c++-common/gomp/imperfect5.c  |   59 +
 gcc/testsuite/g++.dg/gomp/pr41967.C           |    2 +-
 gcc/testsuite/gcc.dg/gomp/collapse-1.c        |   10 +-
 gcc/testsuite/gfortran.dg/gomp/collapse1.f90  |    6 +-
 gcc/testsuite/gfortran.dg/gomp/collapse2.f90  |   10 +-
 gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 |   39 +
 gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 |   56 +
 gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 |   29 +
 gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 |   36 +
 gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 |   67 +
 .../testsuite/libgomp.c++/imperfect-class-1.C |  169 +++
 .../testsuite/libgomp.c++/imperfect-class-2.C |  167 +++
 .../testsuite/libgomp.c++/imperfect-class-3.C |  167 +++
 .../libgomp.c++/imperfect-destructor.C        |  135 ++
 .../libgomp.c++/imperfect-template-1.C        |  172 +++
 .../libgomp.c++/imperfect-template-2.C        |  170 +++
 .../libgomp.c++/imperfect-template-3.C        |  170 +++
 .../libgomp.c-c++-common/imperfect1.c         |   76 ++
 .../libgomp.c-c++-common/imperfect2.c         |  114 ++
 .../libgomp.c-c++-common/imperfect3.c         |  119 ++
 .../libgomp.c-c++-common/imperfect4.c         |  117 ++
 .../libgomp.c-c++-common/imperfect5.c         |   49 +
 .../libgomp.c-c++-common/imperfect6.c         |  115 ++
 .../libgomp.c-c++-common/offload-imperfect1.c |   81 ++
 .../libgomp.c-c++-common/offload-imperfect2.c |  122 ++
 .../libgomp.c-c++-common/offload-imperfect3.c |  125 ++
 .../libgomp.c-c++-common/offload-imperfect4.c |  122 ++
 .../libgomp.fortran/imperfect-destructor.f90  |  142 ++
 .../testsuite/libgomp.fortran/imperfect1.f90  |   67 +
 .../testsuite/libgomp.fortran/imperfect2.f90  |  102 ++
 .../testsuite/libgomp.fortran/imperfect3.f90  |  110 ++
 .../testsuite/libgomp.fortran/imperfect4.f90  |  121 ++
 .../libgomp.fortran/offload-imperfect1.f90    |   72 +
 .../libgomp.fortran/offload-imperfect2.f90    |  110 ++
 .../libgomp.fortran/offload-imperfect3.f90    |  116 ++
 .../libgomp.fortran/offload-imperfect4.f90    |  126 ++
 53 files changed, 5588 insertions(+), 892 deletions(-)
 create mode 100644 gcc/omp-api.h
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect1.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect2.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect3.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect4.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect5.c
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-1.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-2.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-3.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-destructor.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-1.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-2.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-3.C
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect1.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect4.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90

-- 
2.31.1


^ permalink raw reply	[flat|nested] 7+ messages in thread

* [PATCH 1/3] OpenMP: C support for imperfectly-nested loops
  2023-04-28 23:22 [PATCH 0/3] OpenMP: Support imperfectly-nested loops Sandra Loosemore
@ 2023-04-28 23:22 ` Sandra Loosemore
  2023-05-25 10:00   ` Jakub Jelinek
  2023-04-28 23:22 ` [PATCH 2/3] OpenMP: C++ " Sandra Loosemore
  2023-04-28 23:22 ` [PATCH 3/3] OpenMP: Fortran " Sandra Loosemore
  2 siblings, 1 reply; 7+ messages in thread
From: Sandra Loosemore @ 2023-04-28 23:22 UTC (permalink / raw)
  To: gcc-patches

OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop.  In GCC this code is moved
into the inner loop body by the respective front ends.

This patch changes the C front end to use recursive descent parsing
on nested loops within an "omp for" construct, rather than an iterative
approach, in order to preserve proper nesting of compound statements.

gcc/c/ChangeLog
	* c-parser.cc (struct c_parser): Add omp_for_parse_state field.
	(struct omp_for_parse_data): New.
	(c_parser_compound_statement_nostart): Special-case nested
	OMP loops and blocks in intervening code.
	(c_parser_while_statement): Reject in intervening code.
	(c_parser_do_statement): Likewise.
	(c_parser_for_statement): Likewise.
	(c_parser_postfix_expression_after_primary): Reject calls to OMP
	runtime routines in intervening code.
	(c_parser_pragma): Reject OMP pragmas in intervening code.
	(c_parser_omp_loop_nest): New, split from c_parser_omp_for_loop.
	(c_parser_omp_for_loop): Rewrite to use recursive descent and
	generalize handling for intervening code.

gcc/ChangeLog
	* omp-api.h: New file.
	* omp-general.cc (omp_runtime_api_procname): New.
	(omp_runtime_api_call): Moved here from omp-low.cc, and make
	non-static.
	* omp-general.h: Include omp-api.h.
	* omp-low.cc (omp_runtime_api_call): Delete this copy.

gcc/testsuite/ChangeLog
	* c-c++-common/goacc/collapse-1.c: Adjust expected error messages.
	* c-c++-common/goacc/tile-2.c: Likewise.
	* c-c++-common/gomp/imperfect1.c: New.
	* c-c++-common/gomp/imperfect2.c: New.
	* c-c++-common/gomp/imperfect3.c: New.
	* c-c++-common/gomp/imperfect4.c: New.
	* c-c++-common/gomp/imperfect5.c: New.
	* gcc.dg/gomp/collapse-1.c: Adjust expected error messages.

libgomp/ChangeLog
	* testsuite/libgomp.c-c++-common/imperfect1.c: New.
	* testsuite/libgomp.c-c++-common/imperfect2.c: New.
	* testsuite/libgomp.c-c++-common/imperfect3.c: New.
	* testsuite/libgomp.c-c++-common/imperfect4.c: New.
	* testsuite/libgomp.c-c++-common/imperfect5.c: New.
	* testsuite/libgomp.c-c++-common/imperfect6.c: New.
	* testsuite/libgomp.c-c++-common/offload-imperfect1.c: New.
	* testsuite/libgomp.c-c++-common/offload-imperfect2.c: New.
	* testsuite/libgomp.c-c++-common/offload-imperfect3.c: New.
	* testsuite/libgomp.c-c++-common/offload-imperfect4.c: New.
---
 gcc/c/c-parser.cc                             | 692 +++++++++++-------
 gcc/omp-api.h                                 |  32 +
 gcc/omp-general.cc                            | 134 ++++
 gcc/omp-general.h                             |   1 +
 gcc/omp-low.cc                                | 129 ----
 gcc/testsuite/c-c++-common/goacc/collapse-1.c |  14 +-
 gcc/testsuite/c-c++-common/goacc/tile-2.c     |   4 +-
 gcc/testsuite/c-c++-common/gomp/imperfect1.c  |  40 +
 gcc/testsuite/c-c++-common/gomp/imperfect2.c  |  36 +
 gcc/testsuite/c-c++-common/gomp/imperfect3.c  |  35 +
 gcc/testsuite/c-c++-common/gomp/imperfect4.c  |  35 +
 gcc/testsuite/c-c++-common/gomp/imperfect5.c  |  59 ++
 gcc/testsuite/gcc.dg/gomp/collapse-1.c        |  10 +-
 .../libgomp.c-c++-common/imperfect1.c         |  76 ++
 .../libgomp.c-c++-common/imperfect2.c         | 114 +++
 .../libgomp.c-c++-common/imperfect3.c         | 119 +++
 .../libgomp.c-c++-common/imperfect4.c         | 117 +++
 .../libgomp.c-c++-common/imperfect5.c         |  49 ++
 .../libgomp.c-c++-common/imperfect6.c         | 115 +++
 .../libgomp.c-c++-common/offload-imperfect1.c |  81 ++
 .../libgomp.c-c++-common/offload-imperfect2.c | 122 +++
 .../libgomp.c-c++-common/offload-imperfect3.c | 125 ++++
 .../libgomp.c-c++-common/offload-imperfect4.c | 122 +++
 23 files changed, 1870 insertions(+), 391 deletions(-)
 create mode 100644 gcc/omp-api.h
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect1.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect2.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect3.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect4.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect5.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c

diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index c9f06930e3a..891e45ecaea 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -249,6 +249,10 @@ struct GTY(()) c_parser {
 
   /* Location of the last consumed token.  */
   location_t last_token_location;
+
+  /* Holds state for parsing collapsed OMP_FOR loops.  Managed by
+     c_parser_omp_for_loop.  */
+  struct omp_for_parse_data * GTY((skip)) omp_for_parse_state;
 };
 
 /* Return a pointer to the Nth token in PARSERs tokens_buf.  */
@@ -1525,6 +1529,23 @@ struct oacc_routine_data {
 /* Used for parsing objc foreach statements.  */
 static tree objc_foreach_break_label, objc_foreach_continue_label;
 
+/* Used for parsing OMP for loops.  See c_parser_omp_for_loop.  */
+struct omp_for_parse_data {
+  tree declv, condv, incrv, initv;
+  tree pre_body;
+  tree bindings;
+  int collapse;
+  int depth;
+  location_t for_loc;
+  bool want_nested_loop : 1;
+  bool ordered : 1;
+  bool in_intervening_code : 1;
+  bool perfect_nesting_fail : 1;
+  bool fail : 1;
+  bool inscan : 1;
+  enum tree_code code;
+};
+
 static bool c_parser_nth_token_starts_std_attributes (c_parser *,
 						      unsigned int);
 static tree c_parser_std_attribute_specifier_sequence (c_parser *);
@@ -1616,6 +1637,7 @@ static void c_parser_omp_threadprivate (c_parser *);
 static void c_parser_omp_barrier (c_parser *);
 static void c_parser_omp_depobj (c_parser *);
 static void c_parser_omp_flush (c_parser *);
+static tree c_parser_omp_loop_nest (c_parser *, bool *);
 static tree c_parser_omp_for_loop (location_t, c_parser *, enum tree_code,
 				   tree, tree *, bool *);
 static void c_parser_omp_taskwait (c_parser *);
@@ -6123,6 +6145,15 @@ c_parser_compound_statement_nostart (c_parser *parser)
   bool last_label = false;
   bool save_valid_for_pragma = valid_location_for_stdc_pragma_p ();
   location_t label_loc = UNKNOWN_LOCATION;  /* Quiet warning.  */
+  struct omp_for_parse_data *omp_for_parse_state;
+
+  if (parser->omp_for_parse_state
+      && (parser->omp_for_parse_state->depth
+	  < parser->omp_for_parse_state->collapse - 1))
+    omp_for_parse_state = parser->omp_for_parse_state;
+  else
+    omp_for_parse_state = NULL;
+
   if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
     {
       location_t endloc = c_parser_peek_token (parser)->location;
@@ -6289,6 +6320,15 @@ c_parser_compound_statement_nostart (c_parser *parser)
               continue;
             }
         }
+      else if (omp_for_parse_state
+	       && c_parser_next_token_is_keyword (parser, RID_FOR)
+	       && omp_for_parse_state->want_nested_loop)
+	{
+	  /* Special treatment for collapsed loop nests.  */
+	  omp_for_parse_state->depth++;
+	  add_stmt (c_parser_omp_loop_nest (parser, NULL));
+	  omp_for_parse_state->depth--;
+	}
       else
 	{
 	statement:
@@ -6296,7 +6336,52 @@ c_parser_compound_statement_nostart (c_parser *parser)
 	  last_label = false;
 	  last_stmt = true;
 	  mark_valid_location_for_stdc_pragma (false);
-	  c_parser_statement_after_labels (parser, NULL);
+	  if (omp_for_parse_state
+	      && !c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+	    {
+	      /* Nested loops can only appear directly or nested in
+		 compound statements.  We have neither, so set the bit
+		 to treat everything inside the subsequent statement
+		 as intervening code instead.  */
+	      bool want_nested_loop = omp_for_parse_state->want_nested_loop;
+	      omp_for_parse_state->want_nested_loop = false;
+
+	      /* Only diagnose errors related to perfect nesting once.  */
+	      if (!omp_for_parse_state->perfect_nesting_fail)
+		{
+
+		  /* OpenACC does not (yet) permit intervening code, in
+		     addition to situations forbidden by the OpenMP spec.  */
+		  if (omp_for_parse_state->code == OACC_LOOP)
+		    {
+		      error_at (omp_for_parse_state->for_loc,
+				"inner loops must be perfectly nested in "
+				"%<#pragma acc loop%>");
+		      omp_for_parse_state->perfect_nesting_fail = true;
+		    }
+		  else if (omp_for_parse_state->ordered)
+		    {
+		      error_at (omp_for_parse_state->for_loc,
+				"inner loops must be perfectly nested with "
+				"%<ordered%> clause");
+		      omp_for_parse_state->perfect_nesting_fail = true;
+		    }
+		  else if (omp_for_parse_state->inscan)
+		    {
+		      error_at (omp_for_parse_state->for_loc,
+				"inner loops must be perfectly nested with "
+				"%<reduction%> %<inscan%> clause");
+		      omp_for_parse_state->perfect_nesting_fail = true;
+		    }
+		  /* TODO: Also reject loops with TILE directive.  */
+		  if (omp_for_parse_state->perfect_nesting_fail)
+		    omp_for_parse_state->fail = true;
+		}
+	      c_parser_statement_after_labels (parser, NULL);
+	      omp_for_parse_state->want_nested_loop = want_nested_loop;
+	    }
+	  else
+	    c_parser_statement_after_labels (parser, NULL);
 	}
 
       parser->error = false;
@@ -7138,6 +7223,16 @@ c_parser_while_statement (c_parser *parser, bool ivdep, unsigned short unroll,
   gcc_assert (c_parser_next_token_is_keyword (parser, RID_WHILE));
   token_indent_info while_tinfo
     = get_token_indent_info (c_parser_peek_token (parser));
+
+  if (parser->omp_for_parse_state
+      && (parser->omp_for_parse_state->depth
+	  < parser->omp_for_parse_state->collapse - 1))
+    {
+      error_at (c_parser_peek_token (parser)->location,
+		"loop not permitted in intervening code in OMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   c_parser_consume_token (parser);
   block = c_begin_compound_stmt (flag_isoc99);
   loc = c_parser_peek_token (parser)->location;
@@ -7189,6 +7284,16 @@ c_parser_do_statement (c_parser *parser, bool ivdep, unsigned short unroll)
   unsigned char save_in_statement;
   location_t loc;
   gcc_assert (c_parser_next_token_is_keyword (parser, RID_DO));
+
+  if (parser->omp_for_parse_state
+      && (parser->omp_for_parse_state->depth
+	  < parser->omp_for_parse_state->collapse - 1))
+    {
+      error_at (c_parser_peek_token (parser)->location,
+		"loop not permitted in intervening code in OMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   c_parser_consume_token (parser);
   if (c_parser_next_token_is (parser, CPP_SEMICOLON))
     warning_at (c_parser_peek_token (parser)->location,
@@ -7295,6 +7400,16 @@ c_parser_for_statement (c_parser *parser, bool ivdep, unsigned short unroll,
   gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR));
   token_indent_info for_tinfo
     = get_token_indent_info (c_parser_peek_token (parser));
+
+  if (parser->omp_for_parse_state
+      && (parser->omp_for_parse_state->depth
+	  < parser->omp_for_parse_state->collapse - 1))
+    {
+      error_at (for_loc,
+		"loop not permitted in intervening code in OMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   c_parser_consume_token (parser);
   /* Open a compound statement in Objective-C as well, just in case this is
      as foreach expression.  */
@@ -11234,6 +11349,14 @@ c_parser_postfix_expression_after_primary (c_parser *parser,
 		  && fndecl_built_in_p (expr.value, BUILT_IN_NORMAL)
 		  && vec_safe_length (exprlist) == 1)
 		warn_for_abs (expr_loc, expr.value, (*exprlist)[0]);
+	      if (parser->omp_for_parse_state
+		  && parser->omp_for_parse_state->in_intervening_code
+		  && omp_runtime_api_call (expr.value))
+		{
+		  error_at (expr_loc, "Calls to the OpenMP runtime API are "
+				      "not permitted in intervening code");
+		  parser->omp_for_parse_state->fail = true;
+		}
 	    }
 
 	  start = expr.get_start ();
@@ -13068,6 +13191,17 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
   input_location = c_parser_peek_token (parser)->location;
   id = c_parser_peek_token (parser)->pragma_kind;
   gcc_assert (id != PRAGMA_NONE);
+  if (parser->omp_for_parse_state
+      && parser->omp_for_parse_state->in_intervening_code
+      && id >= PRAGMA_OMP__START_
+      && id <= PRAGMA_OMP__LAST_)
+    {
+      error_at (input_location,
+		"intervening code must not contain OpenMP directives");
+      parser->omp_for_parse_state->fail = true;
+      c_parser_skip_until_found (parser, CPP_PRAGMA_EOL, NULL);
+      return false;
+    }
 
   switch (id)
     {
@@ -20190,6 +20324,274 @@ c_parser_omp_scan_loop_body (c_parser *parser, bool open_brace_parsed)
 			     "expected %<}%>");
 }
 
+
+/* This function parses a single level of a loop nest, invoking itself
+   recursively if necessary.
+
+   loop-nest :: for (...) loop-body
+   loop-body :: loop-nest
+	     |  { [intervening-code] loop-body [intervening-code] }
+	     |  final-loop-body
+   intervening-code :: structured-block-sequence
+   final-loop-body :: structured-block
+
+   For a collapsed loop nest, only a single OMP_FOR is built, pulling out
+   all the iterator information from the inner loops into the
+   parser->omp_for_parse_state structure.
+
+   The iterator decl, init, cond, and incr are stored in vectors.
+
+   Initialization code for iterator variables is collected into
+   parser->omp_for_parse_state->pre_body and ends up inserted directly
+   into the OMP_FOR structure.  */
+
+static tree
+c_parser_omp_loop_nest (c_parser *parser, bool *if_p)
+{
+  tree decl, cond, incr, init;
+  tree body = NULL_TREE;
+  matching_parens parens;
+  bool moreloops;
+  unsigned char save_in_statement;
+  tree loop_scope;
+  location_t loc;
+  struct omp_for_parse_data *omp_for_parse_state
+    = parser->omp_for_parse_state;
+
+  gcc_assert (omp_for_parse_state);
+
+  /* We have already matched the FOR token but not consumed it yet.  */
+  loc = c_parser_peek_token (parser)->location;
+  gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR));
+  c_parser_consume_token (parser);
+
+  /* Forbid break/continue in the loop initializer, condition, and
+     increment expressions.  */
+  save_in_statement = in_statement;
+  in_statement = IN_OMP_BLOCK;
+
+  /* We are not in intervening code now.  */
+  omp_for_parse_state->in_intervening_code = false;
+
+  if (!parens.require_open (parser))
+    {
+      omp_for_parse_state->fail = true;
+      return NULL_TREE;
+    }
+
+  /* An implicit scope block surrounds each level of FOR loop, for
+     declarations of iteration variables at this loop depth.  */
+  loop_scope = c_begin_compound_stmt (true);
+
+  /* Parse the initialization declaration or expression.  */
+  if (c_parser_next_tokens_start_declaration (parser))
+    {
+      /* This is a declaration, which must be added to the pre_body code.  */
+      tree this_pre_body = push_stmt_list ();
+      c_in_omp_for = true;
+      c_parser_declaration_or_fndef (parser, true, true, true, true, true);
+      c_in_omp_for = false;
+      this_pre_body = pop_stmt_list (this_pre_body);
+      append_to_statement_list_force (this_pre_body,
+				      &(omp_for_parse_state->pre_body));
+      decl = check_for_loop_decls (omp_for_parse_state->for_loc, flag_isoc99);
+      if (decl == NULL)
+	goto error_init;
+      if (DECL_INITIAL (decl) == error_mark_node)
+	decl = error_mark_node;
+      init = decl;
+    }
+  else if (c_parser_next_token_is (parser, CPP_NAME)
+	   && c_parser_peek_2nd_token (parser)->type == CPP_EQ)
+    {
+      struct c_expr decl_exp;
+      struct c_expr init_exp;
+      location_t init_loc;
+
+      decl_exp = c_parser_postfix_expression (parser);
+      decl = decl_exp.value;
+
+      c_parser_require (parser, CPP_EQ, "expected %<=%>");
+
+      init_loc = c_parser_peek_token (parser)->location;
+      init_exp = c_parser_expr_no_commas (parser, NULL);
+      init_exp = default_function_array_read_conversion (init_loc,
+							 init_exp);
+      c_in_omp_for = true;
+      init = build_modify_expr (init_loc, decl, decl_exp.original_type,
+				NOP_EXPR, init_loc, init_exp.value,
+				init_exp.original_type);
+      c_in_omp_for = false;
+      init = c_process_expr_stmt (init_loc, init);
+
+      c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+    }
+  else
+    {
+    error_init:
+      c_parser_error (parser,
+		      "expected iteration declaration or initialization");
+      c_parser_skip_until_found (parser, CPP_CLOSE_PAREN,
+				 "expected %<)%>");
+      omp_for_parse_state->fail = true;
+      goto parse_next;
+    }
+
+  /* Parse the loop condition.  */
+  cond = NULL_TREE;
+  if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
+    {
+      location_t cond_loc = c_parser_peek_token (parser)->location;
+      c_in_omp_for = true;
+      struct c_expr cond_expr
+	= c_parser_binary_expression (parser, NULL, NULL_TREE);
+      c_in_omp_for = false;
+
+      cond = cond_expr.value;
+      cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
+      switch (cond_expr.original_code)
+	{
+	case GT_EXPR:
+	case GE_EXPR:
+	case LT_EXPR:
+	case LE_EXPR:
+	  break;
+	case NE_EXPR:
+	  if (omp_for_parse_state->code != OACC_LOOP)
+	    break;
+	  /* FALLTHRU.  */
+	default:
+	  /* Can't be cond = error_mark_node, because we want to preserve
+	     the location until c_finish_omp_for.  */
+	  cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node);
+	  break;
+	}
+      protected_set_expr_location (cond, cond_loc);
+    }
+  c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+
+  /* Parse the increment expression.  */
+  incr = NULL_TREE;
+  if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN))
+    {
+      location_t incr_loc = c_parser_peek_token (parser)->location;
+
+      incr = c_process_expr_stmt (incr_loc,
+				  c_parser_expression (parser).value);
+    }
+  parens.skip_until_found_close (parser);
+
+  if (decl == NULL || decl == error_mark_node || init == error_mark_node)
+    omp_for_parse_state->fail = true;
+  else
+    {
+      TREE_VEC_ELT (omp_for_parse_state->declv, omp_for_parse_state->depth)
+	= decl;
+      TREE_VEC_ELT (omp_for_parse_state->initv, omp_for_parse_state->depth)
+	= init;
+      TREE_VEC_ELT (omp_for_parse_state->condv, omp_for_parse_state->depth)
+	= cond;
+      TREE_VEC_ELT (omp_for_parse_state->incrv, omp_for_parse_state->depth)
+	= incr;
+    }
+
+parse_next:
+  omp_for_parse_state->want_nested_loop = true;
+  moreloops = omp_for_parse_state->depth < omp_for_parse_state->collapse - 1;
+  if (moreloops && c_parser_next_token_is_keyword (parser, RID_FOR))
+    {
+      omp_for_parse_state->depth++;
+      body = c_parser_omp_loop_nest (parser, if_p);
+      omp_for_parse_state->depth--;
+    }
+  else if (moreloops && c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+    {
+      /* This is the open brace in the loop-body grammar production.  Rather
+	 than trying to special-case braces, just parse it as a compound
+	 statement and handle the nested loop-body case there.  Note that
+	 when we see a further open brace inside the compound statement
+	 loop-body, we don't know whether it is the start of intervening
+	 code that is a compound statement, or a level of braces
+	 surrounding a nested loop-body.  Use the WANT_NESTED_LOOP state
+	 bit to ensure we have only one nested loop at each level.  */
+      omp_for_parse_state->in_intervening_code = true;
+      body = c_parser_compound_statement (parser, NULL);
+      omp_for_parse_state->in_intervening_code = false;
+      if (omp_for_parse_state->want_nested_loop)
+	{
+	  /* We have already parsed the whole loop body and not found a
+	     nested loop.  */
+	  error_at (omp_for_parse_state->for_loc,
+		    "not enough nested loops");
+	  omp_for_parse_state->fail = true;
+	}
+      if_p = NULL;
+    }
+  else
+    {
+      /* This is the final-loop-body case in the grammar: we have
+	 something that is not a FOR and not an open brace.  */
+      if (moreloops)
+	{
+	  /* If we were expecting a nested loop, give an error and mark
+	     that parsing has failed, and try to recover by parsing the
+	     body as regular code without further collapsing.  */
+	  error_at (omp_for_parse_state->for_loc,
+		    "not enough nested loops");
+	  omp_for_parse_state->fail = true;
+	}
+      in_statement = IN_OMP_FOR;
+      body = push_stmt_list ();
+      if (omp_for_parse_state->inscan)
+	c_parser_omp_scan_loop_body (parser, false);
+      else
+	add_stmt (c_parser_c99_block_statement (parser, if_p));
+      body = pop_stmt_list (body);
+    }
+  in_statement = save_in_statement;
+  omp_for_parse_state->want_nested_loop = false;
+  omp_for_parse_state->in_intervening_code = true;
+
+  /* Pop and return the implicit scope surrounding this level of loop.
+     Any iteration variable bound in loop_scope is pulled out and later
+     will be added to the scope surrounding the entire OMP_FOR.  That
+     keeps the gimplifier happy later on, and meanwhile we have already
+     resolved all references to the iteration variable in its true scope.  */
+  add_stmt (body);
+  body = c_end_compound_stmt (loc, loop_scope, true);
+  if (decl && TREE_CODE (body) == BIND_EXPR)
+    {
+      tree t = BIND_EXPR_VARS (body);
+      tree prev = NULL_TREE, next = NULL_TREE;
+      while (t)
+	{
+	  next = DECL_CHAIN (t);
+	  if (t == decl)
+	    {
+	      if (prev)
+		DECL_CHAIN (prev) = next;
+	      else
+		{
+		  BIND_EXPR_VARS (body) = next;
+		  BLOCK_VARS (BIND_EXPR_BLOCK (body)) = next;
+		}
+	      DECL_CHAIN (t) = omp_for_parse_state->bindings;
+	      omp_for_parse_state->bindings = t;
+	      break;
+	    }
+	  else
+	    {
+	      prev = t;
+	      t = next;
+	    }
+	}
+      if (BIND_EXPR_VARS (body) == NULL_TREE)
+	body = BIND_EXPR_BODY (body);
+    }
+
+  return body;
+}
+
 /* Parse the restricted form of loop statements allowed by OpenACC and OpenMP.
    The real trick here is to determine the loop control variable early
    so that we can push a new decl if necessary to make it private.
@@ -20200,17 +20602,15 @@ static tree
 c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 		       tree clauses, tree *cclauses, bool *if_p)
 {
-  tree decl, cond, incr, body, init, stmt, cl;
-  unsigned char save_in_statement;
-  tree declv, condv, incrv, initv, ret = NULL_TREE;
-  tree pre_body = NULL_TREE, this_pre_body;
+  tree body, stmt, cl;
+  tree ret = NULL_TREE;
   tree ordered_cl = NULL_TREE;
-  bool fail = false, open_brace_parsed = false;
-  int i, collapse = 1, ordered = 0, count, nbraces = 0;
+  int i, collapse = 1, ordered = 0, count;
   location_t for_loc;
   bool tiling = false;
   bool inscan = false;
-  vec<tree, va_gc> *for_block = make_tree_vector ();
+  struct omp_for_parse_data data;
+  struct omp_for_parse_data *save_data = parser->omp_for_parse_state;
 
   for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
     if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE)
@@ -20243,250 +20643,53 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
   gcc_assert (tiling || (collapse >= 1 && ordered >= 0));
   count = ordered ? ordered : collapse;
 
-  declv = make_tree_vec (count);
-  initv = make_tree_vec (count);
-  condv = make_tree_vec (count);
-  incrv = make_tree_vec (count);
-
   if (!c_parser_next_token_is_keyword (parser, RID_FOR))
     {
       c_parser_error (parser, "for statement expected");
       return NULL;
     }
   for_loc = c_parser_peek_token (parser)->location;
-  c_parser_consume_token (parser);
-
-  /* Forbid break/continue in the loop initializer, condition, and
-     increment expressions.  */
-  save_in_statement = in_statement;
-  in_statement = IN_OMP_BLOCK;
-
-  for (i = 0; i < count; i++)
-    {
-      int bracecount = 0;
-
-      matching_parens parens;
-      if (!parens.require_open (parser))
-	goto pop_scopes;
-
-      /* Parse the initialization declaration or expression.  */
-      if (c_parser_next_tokens_start_declaration (parser))
-	{
-	  if (i > 0)
-	    vec_safe_push (for_block, c_begin_compound_stmt (true));
-	  this_pre_body = push_stmt_list ();
-	  c_in_omp_for = true;
-	  c_parser_declaration_or_fndef (parser, true, true, true, true, true);
-	  c_in_omp_for = false;
-	  if (this_pre_body)
-	    {
-	      this_pre_body = pop_stmt_list (this_pre_body);
-	      if (pre_body)
-		{
-		  tree t = pre_body;   
-		  pre_body = push_stmt_list ();
-		  add_stmt (t);
-		  add_stmt (this_pre_body);
-		  pre_body = pop_stmt_list (pre_body);
-		}
-	      else
-		pre_body = this_pre_body;
-	    }
-	  decl = check_for_loop_decls (for_loc, flag_isoc99);
-	  if (decl == NULL)
-	    goto error_init;
-	  if (DECL_INITIAL (decl) == error_mark_node)
-	    decl = error_mark_node;
-	  init = decl;
-	}
-      else if (c_parser_next_token_is (parser, CPP_NAME)
-	       && c_parser_peek_2nd_token (parser)->type == CPP_EQ)
-	{
-	  struct c_expr decl_exp;
-	  struct c_expr init_exp;
-	  location_t init_loc;
-
-	  decl_exp = c_parser_postfix_expression (parser);
-	  decl = decl_exp.value;
-
-	  c_parser_require (parser, CPP_EQ, "expected %<=%>");
-
-	  init_loc = c_parser_peek_token (parser)->location;
-	  init_exp = c_parser_expr_no_commas (parser, NULL);
-	  init_exp = default_function_array_read_conversion (init_loc,
-							     init_exp);
-	  c_in_omp_for = true;
-	  init = build_modify_expr (init_loc, decl, decl_exp.original_type,
-				    NOP_EXPR, init_loc, init_exp.value,
-				    init_exp.original_type);
-	  c_in_omp_for = false;
-	  init = c_process_expr_stmt (init_loc, init);
-
-	  c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
-	}
-      else
-	{
-	error_init:
-	  c_parser_error (parser,
-			  "expected iteration declaration or initialization");
-	  c_parser_skip_until_found (parser, CPP_CLOSE_PAREN,
-				     "expected %<)%>");
-	  fail = true;
-	  goto parse_next;
-	}
-
-      /* Parse the loop condition.  */
-      cond = NULL_TREE;
-      if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
-	{
-	  location_t cond_loc = c_parser_peek_token (parser)->location;
-	  c_in_omp_for = true;
-	  struct c_expr cond_expr
-	    = c_parser_binary_expression (parser, NULL, NULL_TREE);
-          c_in_omp_for = false;
-
-	  cond = cond_expr.value;
-	  cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
-	  switch (cond_expr.original_code)
-	    {
-	    case GT_EXPR:
-	    case GE_EXPR:
-	    case LT_EXPR:
-	    case LE_EXPR:
-	      break;
-	    case NE_EXPR:
-	      if (code != OACC_LOOP)
-		break;
-	      /* FALLTHRU.  */
-	    default:
-	      /* Can't be cond = error_mark_node, because we want to preserve
-		 the location until c_finish_omp_for.  */
-	      cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node);
-	      break;
-	    }
-	  protected_set_expr_location (cond, cond_loc);
-	}
-      c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
-
-      /* Parse the increment expression.  */
-      incr = NULL_TREE;
-      if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN))
-	{
-	  location_t incr_loc = c_parser_peek_token (parser)->location;
 
-	  incr = c_process_expr_stmt (incr_loc,
-				      c_parser_expression (parser).value);
-	}
-      parens.skip_until_found_close (parser);
-
-      if (decl == NULL || decl == error_mark_node || init == error_mark_node)
-	fail = true;
-      else
-	{
-	  TREE_VEC_ELT (declv, i) = decl;
-	  TREE_VEC_ELT (initv, i) = init;
-	  TREE_VEC_ELT (condv, i) = cond;
-	  TREE_VEC_ELT (incrv, i) = incr;
-	}
-
-    parse_next:
-      if (i == count - 1)
-	break;
-
-      /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed
-	 in between the collapsed for loops to be still considered perfectly
-	 nested.  Hopefully the final version clarifies this.
-	 For now handle (multiple) {'s and empty statements.  */
-      do
-	{
-	  if (c_parser_next_token_is_keyword (parser, RID_FOR))
-	    {
-	      c_parser_consume_token (parser);
-	      break;
-	    }
-	  else if (c_parser_next_token_is (parser, CPP_OPEN_BRACE))
-	    {
-	      c_parser_consume_token (parser);
-	      bracecount++;
-	    }
-	  else if (bracecount
-		   && c_parser_next_token_is (parser, CPP_SEMICOLON))
-	    c_parser_consume_token (parser);
-	  else
-	    {
-	      c_parser_error (parser, "not enough perfectly nested loops");
-	      if (bracecount)
-		{
-		  open_brace_parsed = true;
-		  bracecount--;
-		}
-	      fail = true;
-	      count = 0;
-	      break;
-	    }
-	}
-      while (1);
-
-      nbraces += bracecount;
-    }
-
-  if (nbraces)
-    if_p = NULL;
-
-  in_statement = IN_OMP_FOR;
-  body = push_stmt_list ();
-
-  if (inscan)
-    c_parser_omp_scan_loop_body (parser, open_brace_parsed);
-  else if (open_brace_parsed)
-    {
-      location_t here = c_parser_peek_token (parser)->location;
-      stmt = c_begin_compound_stmt (true);
-      c_parser_compound_statement_nostart (parser);
-      add_stmt (c_end_compound_stmt (here, stmt, true));
-    }
-  else
-    add_stmt (c_parser_c99_block_statement (parser, if_p));
-
-  body = pop_stmt_list (body);
-  in_statement = save_in_statement;
-
-  while (nbraces)
-    {
-      if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
-	{
-	  c_parser_consume_token (parser);
-	  nbraces--;
-	}
-      else if (c_parser_next_token_is (parser, CPP_SEMICOLON))
-	c_parser_consume_token (parser);
-      else
-	{
-	  c_parser_error (parser, "collapsed loops not perfectly nested");
-	  while (nbraces)
-	    {
-	      location_t here = c_parser_peek_token (parser)->location;
-	      stmt = c_begin_compound_stmt (true);
-	      add_stmt (body);
-	      c_parser_compound_statement_nostart (parser);
-	      body = c_end_compound_stmt (here, stmt, true);
-	      nbraces--;
-	    }
-	  goto pop_scopes;
-	}
+  /* Initialize parse state for recursive descent.  */
+  data.declv = make_tree_vec (count);
+  data.initv = make_tree_vec (count);
+  data.condv = make_tree_vec (count);
+  data.incrv = make_tree_vec (count);
+  data.pre_body = NULL_TREE;;
+  data.bindings = NULL_TREE;
+  data.for_loc = for_loc;
+  data.collapse = count;
+  data.depth = 0;
+  data.want_nested_loop = true;
+  data.ordered = ordered > 0;
+  data.in_intervening_code = false;
+  data.perfect_nesting_fail = false;
+  data.fail = false;
+  data.inscan = inscan;
+  data.code = code;
+  parser->omp_for_parse_state = &data;
+
+  body = c_parser_omp_loop_nest (parser, if_p);
+  for (tree t = data.bindings; t; )
+    {
+      tree n = TREE_CHAIN (t);
+      TREE_CHAIN (t) = NULL_TREE;
+      pushdecl (t);
+      t = n;
     }
 
   /* Only bother calling c_finish_omp_for if we haven't already generated
      an error from the initialization parsing.  */
-  if (!fail)
+  if (!data.fail)
     {
       c_in_omp_for = true;
-      stmt = c_finish_omp_for (loc, code, declv, NULL, initv, condv,
-			       incrv, body, pre_body, true);
+      stmt = c_finish_omp_for (loc, code, data.declv, NULL, data.initv,
+			       data.condv, data.incrv,
+			       body, data.pre_body, true);
       c_in_omp_for = false;
 
       /* Check for iterators appearing in lb, b or incr expressions.  */
-      if (stmt && !c_omp_check_loop_iv (stmt, declv, NULL))
+      if (stmt && !c_omp_check_loop_iv (stmt, data.declv, NULL))
 	stmt = NULL_TREE;
 
       if (stmt)
@@ -20538,7 +20741,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 		else
 		  {
 		    for (i = 0; i < count; i++)
-		      if (TREE_VEC_ELT (declv, i) == OMP_CLAUSE_DECL (*c))
+		      if (TREE_VEC_ELT (data.declv, i) == OMP_CLAUSE_DECL (*c))
 			break;
 		    if (i == count)
 		      c = &OMP_CLAUSE_CHAIN (*c);
@@ -20551,7 +20754,8 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 		      }
 		    else
 		      {
-			/* Move lastprivate (decl) clause to OMP_FOR_CLAUSES.  */
+			/* Move lastprivate (decl) clause to
+			   OMP_FOR_CLAUSES.  */
 			tree l = *c;
 			*c = OMP_CLAUSE_CHAIN (*c);
 			if (code == OMP_SIMD)
@@ -20572,16 +20776,8 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
 	}
       ret = stmt;
     }
-pop_scopes:
-  while (!for_block->is_empty ())
-    {
-      /* FIXME diagnostics: LOC below should be the actual location of
-	 this particular for block.  We need to build a list of
-	 locations to go along with FOR_BLOCK.  */
-      stmt = c_end_compound_stmt (loc, for_block->pop (), true);
-      add_stmt (stmt);
-    }
-  release_tree_vector (for_block);
+
+  parser->omp_for_parse_state = save_data;
   return ret;
 }
 
diff --git a/gcc/omp-api.h b/gcc/omp-api.h
new file mode 100644
index 00000000000..2a7ec7b72a6
--- /dev/null
+++ b/gcc/omp-api.h
@@ -0,0 +1,32 @@
+/* Functions for querying whether a function name is reserved by the
+   OpenMP API.  This is used for error checking.
+
+   Copyright (C) 2023 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GCC_OMP_API_H
+#define GCC_OMP_API_H
+
+#include "coretypes.h"
+
+/* In omp-general.cc, but declared in a separate header file for
+   convenience of the Fortran front end.  */
+extern bool omp_runtime_api_procname (const char *name);
+extern bool omp_runtime_api_call (const_tree fndecl);
+
+#endif
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index eefdcb54590..1e31014c454 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3013,4 +3013,138 @@ omp_build_component_ref (tree obj, tree field)
   return ret;
 }
 
+/* Return true if NAME is the name of an omp_* runtime API call.  */
+bool
+omp_runtime_api_procname (const char *name)
+{
+  if (!startswith (name, "omp_"))
+    return false;
+
+  static const char *omp_runtime_apis[] =
+    {
+      /* This array has 3 sections.  First omp_* calls that don't
+	 have any suffixes.  */
+      "aligned_alloc",
+      "aligned_calloc",
+      "alloc",
+      "calloc",
+      "free",
+      "get_mapped_ptr",
+      "realloc",
+      "target_alloc",
+      "target_associate_ptr",
+      "target_disassociate_ptr",
+      "target_free",
+      "target_is_accessible",
+      "target_is_present",
+      "target_memcpy",
+      "target_memcpy_async",
+      "target_memcpy_rect",
+      "target_memcpy_rect_async",
+      NULL,
+      /* Now omp_* calls that are available as omp_* and omp_*_; however, the
+	 DECL_NAME is always omp_* without tailing underscore.  */
+      "capture_affinity",
+      "destroy_allocator",
+      "destroy_lock",
+      "destroy_nest_lock",
+      "display_affinity",
+      "fulfill_event",
+      "get_active_level",
+      "get_affinity_format",
+      "get_cancellation",
+      "get_default_allocator",
+      "get_default_device",
+      "get_device_num",
+      "get_dynamic",
+      "get_initial_device",
+      "get_level",
+      "get_max_active_levels",
+      "get_max_task_priority",
+      "get_max_teams",
+      "get_max_threads",
+      "get_nested",
+      "get_num_devices",
+      "get_num_places",
+      "get_num_procs",
+      "get_num_teams",
+      "get_num_threads",
+      "get_partition_num_places",
+      "get_place_num",
+      "get_proc_bind",
+      "get_supported_active_levels",
+      "get_team_num",
+      "get_teams_thread_limit",
+      "get_thread_limit",
+      "get_thread_num",
+      "get_wtick",
+      "get_wtime",
+      "in_explicit_task",
+      "in_final",
+      "in_parallel",
+      "init_lock",
+      "init_nest_lock",
+      "is_initial_device",
+      "pause_resource",
+      "pause_resource_all",
+      "set_affinity_format",
+      "set_default_allocator",
+      "set_lock",
+      "set_nest_lock",
+      "test_lock",
+      "test_nest_lock",
+      "unset_lock",
+      "unset_nest_lock",
+      NULL,
+      /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
+	 as DECL_NAME only omp_* and omp_*_8 appear.  */
+      "display_env",
+      "get_ancestor_thread_num",
+      "init_allocator",
+      "get_partition_place_nums",
+      "get_place_num_procs",
+      "get_place_proc_ids",
+      "get_schedule",
+      "get_team_size",
+      "set_default_device",
+      "set_dynamic",
+      "set_max_active_levels",
+      "set_nested",
+      "set_num_teams",
+      "set_num_threads",
+      "set_schedule",
+      "set_teams_thread_limit"
+    };
+
+  int mode = 0;
+  for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++)
+    {
+      if (omp_runtime_apis[i] == NULL)
+	{
+	  mode++;
+	  continue;
+	}
+      size_t len = strlen (omp_runtime_apis[i]);
+      if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
+	  && (name[4 + len] == '\0'
+	      || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
+	return true;
+    }
+  return false;
+}
+
+/* Return true if FNDECL is an omp_* runtime API call.  */
+
+bool
+omp_runtime_api_call (const_tree fndecl)
+{
+  tree declname = DECL_NAME (fndecl);
+  if (!declname
+      || (DECL_CONTEXT (fndecl) != NULL_TREE
+	  && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL)
+      || !TREE_PUBLIC (fndecl))
+    return false;
+  return omp_runtime_api_procname (IDENTIFIER_POINTER (declname));
+}
+
 #include "gt-omp-general.h"
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 92717db1628..1a52bfdb56b 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3.  If not see
 #define GCC_OMP_GENERAL_H
 
 #include "gomp-constants.h"
+#include "omp-api.h"
 
 /*  Flags for an OpenACC loop.  */
 
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index dddf5b59d8f..77adf97896a 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -4006,135 +4006,6 @@ setjmp_or_longjmp_p (const_tree fndecl)
   return !strcmp (name, "setjmp") || !strcmp (name, "longjmp");
 }
 
-/* Return true if FNDECL is an omp_* runtime API call.  */
-
-static bool
-omp_runtime_api_call (const_tree fndecl)
-{
-  tree declname = DECL_NAME (fndecl);
-  if (!declname
-      || (DECL_CONTEXT (fndecl) != NULL_TREE
-          && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL)
-      || !TREE_PUBLIC (fndecl))
-    return false;
-
-  const char *name = IDENTIFIER_POINTER (declname);
-  if (!startswith (name, "omp_"))
-    return false;
-
-  static const char *omp_runtime_apis[] =
-    {
-      /* This array has 3 sections.  First omp_* calls that don't
-	 have any suffixes.  */
-      "aligned_alloc",
-      "aligned_calloc",
-      "alloc",
-      "calloc",
-      "free",
-      "get_mapped_ptr",
-      "realloc",
-      "target_alloc",
-      "target_associate_ptr",
-      "target_disassociate_ptr",
-      "target_free",
-      "target_is_accessible",
-      "target_is_present",
-      "target_memcpy",
-      "target_memcpy_async",
-      "target_memcpy_rect",
-      "target_memcpy_rect_async",
-      NULL,
-      /* Now omp_* calls that are available as omp_* and omp_*_; however, the
-	 DECL_NAME is always omp_* without tailing underscore.  */
-      "capture_affinity",
-      "destroy_allocator",
-      "destroy_lock",
-      "destroy_nest_lock",
-      "display_affinity",
-      "fulfill_event",
-      "get_active_level",
-      "get_affinity_format",
-      "get_cancellation",
-      "get_default_allocator",
-      "get_default_device",
-      "get_device_num",
-      "get_dynamic",
-      "get_initial_device",
-      "get_level",
-      "get_max_active_levels",
-      "get_max_task_priority",
-      "get_max_teams",
-      "get_max_threads",
-      "get_nested",
-      "get_num_devices",
-      "get_num_places",
-      "get_num_procs",
-      "get_num_teams",
-      "get_num_threads",
-      "get_partition_num_places",
-      "get_place_num",
-      "get_proc_bind",
-      "get_supported_active_levels",
-      "get_team_num",
-      "get_teams_thread_limit",
-      "get_thread_limit",
-      "get_thread_num",
-      "get_wtick",
-      "get_wtime",
-      "in_explicit_task",
-      "in_final",
-      "in_parallel",
-      "init_lock",
-      "init_nest_lock",
-      "is_initial_device",
-      "pause_resource",
-      "pause_resource_all",
-      "set_affinity_format",
-      "set_default_allocator",
-      "set_lock",
-      "set_nest_lock",
-      "test_lock",
-      "test_nest_lock",
-      "unset_lock",
-      "unset_nest_lock",
-      NULL,
-      /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
-	 as DECL_NAME only omp_* and omp_*_8 appear.  */
-      "display_env",
-      "get_ancestor_thread_num",
-      "init_allocator",
-      "get_partition_place_nums",
-      "get_place_num_procs",
-      "get_place_proc_ids",
-      "get_schedule",
-      "get_team_size",
-      "set_default_device",
-      "set_dynamic",
-      "set_max_active_levels",
-      "set_nested",
-      "set_num_teams",
-      "set_num_threads",
-      "set_schedule",
-      "set_teams_thread_limit"
-    };
-
-  int mode = 0;
-  for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++)
-    {
-      if (omp_runtime_apis[i] == NULL)
-	{
-	  mode++;
-	  continue;
-	}
-      size_t len = strlen (omp_runtime_apis[i]);
-      if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
-	  && (name[4 + len] == '\0'
-	      || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
-	return true;
-    }
-  return false;
-}
-
 /* Helper function for scan_omp.
 
    Callback for walk_gimple_stmt used to scan for OMP directives in
diff --git a/gcc/testsuite/c-c++-common/goacc/collapse-1.c b/gcc/testsuite/c-c++-common/goacc/collapse-1.c
index 11b14383983..05025e64af7 100644
--- a/gcc/testsuite/c-c++-common/goacc/collapse-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/collapse-1.c
@@ -8,8 +8,8 @@ f1 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
-    ;					/* { dg-error "not enough perfectly nested" } */
+  for (i = 0; i < 5; i++)	/* { dg-error "not enough nested loops" } */
+    ;
   {
     for (j = 0; j < 5; j++)
       ;
@@ -40,7 +40,7 @@ f3 (void)
   #pragma acc loop collapse (2)
   for (i = 0; i < 5; i++)
     {
-      int k = foo ();			/* { dg-error "not enough perfectly nested" } */
+      int k = foo ();
       {
 	{
 	  for (j = 0; j < 5; j++)
@@ -56,12 +56,12 @@ f4 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
+  for (i = 0; i < 5; i++)	/* { dg-error "inner loops must be perfectly nested" } */
     {
       {
 	for (j = 0; j < 5; j++)
 	  ;
-	foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+	foo ();
       }
     }
 }
@@ -71,13 +71,13 @@ f5 (void)
 {
   #pragma acc parallel
   #pragma acc loop collapse (2)
-  for (i = 0; i < 5; i++)
+  for (i = 0; i < 5; i++)	/* { dg-error "inner loops must be perfectly nested" } */
     {
       {
 	for (j = 0; j < 5; j++)
 	  ;
       }
-      foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+      foo ();
     }
 }
 
diff --git a/gcc/testsuite/c-c++-common/goacc/tile-2.c b/gcc/testsuite/c-c++-common/goacc/tile-2.c
index c8b240d225b..dc306703260 100644
--- a/gcc/testsuite/c-c++-common/goacc/tile-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/tile-2.c
@@ -3,8 +3,8 @@ int main ()
 #pragma acc parallel
   {
 #pragma acc loop tile (*,*)
-    for (int ix = 0; ix < 30; ix++)
-      ; /* { dg-error "not enough" } */
+    for (int ix = 0; ix < 30; ix++) /* { dg-error "not enough" } */
+      ;
 
 #pragma acc loop tile (*,*)
     for (int ix = 0; ix < 30; ix++)
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect1.c b/gcc/testsuite/c-c++-common/gomp/imperfect1.c
new file mode 100644
index 00000000000..a95f972e0d7
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect1.c
@@ -0,0 +1,40 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors.  */
+
+static int f1count[3], f2count[3];
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      f1 (0, i);
+      for (j = 0; j < a2; j++)
+	{
+#pragma omp barrier	/* { dg-error "intervening code must not contain OpenMP directives" } */
+	  f1 (1, j);
+	  if (i == 2)
+	    continue;	/* { dg-error "invalid exit" } */
+	  else
+	    break;	/* { dg-error "invalid exit" } */
+	  for (k = 0; k < a3; k++)
+	    {
+	      f1 (2, k);
+	      f2 (2, k);
+	    }
+	  f2 (1, j);
+	}
+      for (k = 0; k < a3; k++)	/* { dg-error "loop not permitted in intervening code " } */
+	{
+	  f1 (2, k);
+	  f2 (2, k);
+	}
+      f2 (0, i);
+    }
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect2.c b/gcc/testsuite/c-c++-common/gomp/imperfect2.c
new file mode 100644
index 00000000000..9649f28503b
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect2.c
@@ -0,0 +1,36 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors.  */
+
+/* These functions that are part of the OpenMP runtime API would ordinarily
+   be declared in omp.h, but we don't have that here.  */
+extern int omp_get_num_threads(void);
+extern int omp_get_max_threads(void);
+
+static int f1count[3], f2count[3];
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      f1 (0, i);
+      for (j = 0; j < omp_get_num_threads (); j++)  /* This is OK */
+	{
+	  f1 (1, omp_get_num_threads ());  /* { dg-error "not permitted in intervening code" } */
+	  for (k = omp_get_num_threads (); k < a3; k++)  /* This is OK */
+	    {
+	      f1 (2, omp_get_num_threads ());
+	      f2 (2, omp_get_max_threads ());
+	    }
+	  f2 (1, omp_get_max_threads ());  /* { dg-error "not permitted in intervening code" } */
+	}
+      f2 (0, i);
+    }
+}
+
+
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect3.c b/gcc/testsuite/c-c++-common/gomp/imperfect3.c
new file mode 100644
index 00000000000..a29157094b0
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect3.c
@@ -0,0 +1,35 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors.  */
+
+/* Test that the imperfectly-nested loops with the ordered clause gives
+   an error, and that there is only one error (and not one on every
+   intervening statement).  */
+
+static int f1count[3], f2count[3];
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for ordered(3)
+  for (i = 0; i < a1; i++)  /* { dg-error "inner loops must be perfectly nested" } */
+    {
+      f1 (0, i);
+      for (j = 0; j < a2; j++)
+	{
+	  f1 (1, j);
+	  for (k = 0; k < a3; k++)
+	    {
+	      f1 (2, k);
+	      f2 (2, k);
+	    }
+	  f2 (1, j);
+	}
+      f2 (0, i);
+    }
+}
+
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect4.c b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
new file mode 100644
index 00000000000..e5feff730a9
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
@@ -0,0 +1,35 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors.  */
+
+static int f1count[3], f2count[3];
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(4)
+  for (i = 0; i < a1; i++)	/* { dg-error "not enough nested loops" } */
+    {
+      f1 (0, i);
+      for (j = 0; j < a2; j++)
+	{
+	  f1 (1, j);
+	  for (k = 0; k < a3; k++)
+	    {
+	      /* According to the grammar, this is intervening code; we
+		 don't know that we are also missing a nested for loop
+		 until we have parsed this whole compound expression.  */
+#pragma omp barrier	/* { dg-error "intervening code must not contain OpenMP directives" } */
+	      f1 (2, k);
+	      f2 (2, k);
+	    }
+	  f2 (1, j);
+	}
+      f2 (0, i);
+    }
+}
+
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect5.c b/gcc/testsuite/c-c++-common/gomp/imperfect5.c
new file mode 100644
index 00000000000..7294a816aba
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect5.c
@@ -0,0 +1,59 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors.  */
+
+static int f1count[3], f2count[3];
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+int ijk (int x, int y, int z);
+void f3 (int sum);
+
+/* This function isn't particularly meaningful, but it should compile without
+   error.  */
+int s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+  int r = 0;
+
+#pragma omp simd collapse(3) reduction (inscan, +:r)
+  for (i = 0; i < a1; i++)
+    {
+      for (j = 0; j < a2; j++)
+	{
+	  for (k = 0; k < a3; k++)
+	    {
+	      r = r + ijk (i, j, k);
+#pragma omp scan exclusive (r)
+	      f3 (r);
+	    }
+	}
+    }
+  return r;
+}
+
+/* Adding intervening code should trigger an error.  */
+int s2 (int a1, int a2, int a3)
+{
+  int i, j, k;
+  int r = 0;
+
+#pragma omp simd collapse(3) reduction (inscan, +:r)
+  for (i = 0; i < a1; i++)  /* { dg-error "inner loops must be perfectly nested" } */
+    {
+      f1 (0, i);
+      for (j = 0; j < a2; j++)
+	{
+	  f1 (1, j);
+	  for (k = 0; k < a3; k++)
+	    {
+	      r = r + ijk (i, j, k);
+#pragma omp scan exclusive (r)
+	      f3 (r);
+	    }
+	  f2 (1, j);
+	}
+      f2 (0, i);
+    }
+  return r;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/collapse-1.c b/gcc/testsuite/gcc.dg/gomp/collapse-1.c
index 89b76bb669c..16a102ff3fd 100644
--- a/gcc/testsuite/gcc.dg/gomp/collapse-1.c
+++ b/gcc/testsuite/gcc.dg/gomp/collapse-1.c
@@ -8,8 +8,8 @@ void
 f1 (void)
 {
   #pragma omp for collapse (2)
-  for (i = 0; i < 5; i++)
-    ;					/* { dg-error "not enough perfectly nested" } */
+  for (i = 0; i < 5; i++)	/* { dg-error "not enough nested loops" } */
+    ;
   {
     for (j = 0; j < 5; j++)
       ;
@@ -38,7 +38,7 @@ f3 (void)
   #pragma omp for collapse (2)
   for (i = 0; i < 5; i++)
     {
-      int k = foo ();			/* { dg-error "not enough perfectly nested" } */
+      int k = foo ();
       {
 	{
 	  for (j = 0; j < 5; j++)
@@ -58,7 +58,7 @@ f4 (void)
       {
 	for (j = 0; j < 5; j++)
 	  ;
-	foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+	foo ();
       }
     }
 }
@@ -73,7 +73,7 @@ f5 (void)
 	for (j = 0; j < 5; j++)
 	  ;
       }
-      foo ();				/* { dg-error "collapsed loops not perfectly nested before" } */
+      foo ();
     }
 }
 
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
new file mode 100644
index 00000000000..cafdcaf25b0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
@@ -0,0 +1,76 @@
+/* { dg-do run } */
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  f2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      f1 (0, i);
+      for (j = 0; j < a2; j++)
+	{
+	  f1 (1, j);
+	  for (k = 0; k < a3; k++)
+	    {
+	      f1 (2, k);
+	      f2 (2, k);
+	    }
+	  f2 (1, j);
+	}
+      f2 (0, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
new file mode 100644
index 00000000000..e2098006eab
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
@@ -0,0 +1,114 @@
+/* { dg-do run } */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      f1 (0, i);
+      {
+	g1 (0, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    f1 (1, j);
+	    {
+	      g1 (1, j);
+	      for (k = 0; k < a3; k++)
+		{
+		  f1 (2, k);
+		  {
+		    g1 (2, k);
+		    g2 (2, k);
+		  }
+		  f2 (2, k);
+		}
+	      g2 (1, j);
+	    }
+	  f2 (1, j);
+	  }
+	g2 (0, i);
+      }
+      f2 (0, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
new file mode 100644
index 00000000000..feb5e32d1d6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
@@ -0,0 +1,119 @@
+/* { dg-do run } */
+
+/* Like imperfect2.c, but includes bindings in the blocks.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      int local0 = 0;
+      f1 (local0, i);
+      {
+	g1 (local0, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    int local1 = 1;
+	    f1 (local1, j);
+	    {
+	      g1 (local1, j);
+	      for (k = 0; k < a3; k++)
+		{
+		  int local2 = 2;
+		  f1 (local2, k);
+		  {
+		    g1 (local2, k);
+		    g2 (local2, k);
+		  }
+		  f2 (local2, k);
+		}
+	      g2 (local1, j);
+	    }
+	  f2 (local1, j);
+	  }
+	g2 (local0, i);
+      }
+      f2 (local0, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
new file mode 100644
index 00000000000..e29301bfbad
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
@@ -0,0 +1,117 @@
+/* { dg-do run } */
+
+/* Like imperfect2.c, but includes blocks that are themselves intervening
+   code.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      { f1 (0, i); }
+      {
+	g1 (0, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    { f1 (1, j); }
+	    {
+	      { g1 (1, j); }
+	      for (k = 0; k < a3; k++)
+		{
+		  f1 (2, k);
+		  {
+		    g1 (2, k);
+		    g2 (2, k);
+		  }
+		  f2 (2, k);
+		}
+	      { g2 (1, j); }
+	    }
+	    { f2 (1, j); }
+	  }
+	{ g2 (0, i); }
+      }
+      { f2 (0, i); }
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
new file mode 100644
index 00000000000..7bd4f12d472
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
@@ -0,0 +1,49 @@
+/* { dg-do run } */
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+static int inner_loop_count = 0;
+static int intervening_code_count = 0;
+
+void
+g (int x, int y)
+{
+  inner_loop_count++;
+}
+
+int
+foo (int imax, int jmax)
+{
+  int j = 0;
+
+#pragma omp for collapse(2)
+  for (int i = 0; i < imax; ++i)
+    {
+      /* All the intervening code at the same level must be executed
+	 the same number of times.  */
+      ++intervening_code_count;
+      for (int j = 0; j < jmax; ++j)
+	{
+	  g (i, j);
+	}
+      /* This is the outer j, not the one from the inner collapsed loop.  */
+      ++j;
+    }
+  return j;
+}
+
+int
+main (void)
+{
+  int j = foo (5, 3);
+  if (j != intervening_code_count)
+    abort ();
+  if (inner_loop_count != 5 * 3)
+    abort ();
+  if (intervening_code_count < 5 || intervening_code_count > 5 * 3)
+    abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
new file mode 100644
index 00000000000..808c6540890
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
@@ -0,0 +1,115 @@
+/* { dg-do run } */
+
+/* Like imperfect4.c, but bind the iteration variables in the loops.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+
+#pragma omp for collapse(3)
+  for (int i = 0; i < a1; i++)
+    {
+      { f1 (0, i); }
+      {
+	g1 (0, i);
+	for (int j = 0; j < a2; j++)
+	  {
+	    { f1 (1, j); }
+	    {
+	      { g1 (1, j); }
+	      for (int k = 0; k < a3; k++)
+		{
+		  f1 (2, k);
+		  {
+		    g1 (2, k);
+		    g2 (2, k);
+		  }
+		  f2 (2, k);
+		}
+	      { g2 (1, j); }
+	    }
+	    { f2 (1, j); }
+	  }
+	{ g2 (0, i); }
+      }
+      { f2 (0, i); }
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c
new file mode 100644
index 00000000000..53bc611ace3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect1.c
@@ -0,0 +1,81 @@
+/* { dg-do run } */
+
+/* Like imperfect1.c, but enables offloading.  */
+
+static int f1count[3], f2count[3];
+#pragma omp declare target enter (f1count, f2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  #pragma omp atomic
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  #pragma omp atomic
+  f2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count)
+  for (i = 0; i < a1; i++)
+    {
+      f1 (0, i);
+      for (j = 0; j < a2; j++)
+	{
+	  f1 (1, j);
+	  for (k = 0; k < a3; k++)
+	    {
+	      f1 (2, k);
+	      f2 (2, k);
+	    }
+	  f2 (1, j);
+	}
+      f2 (0, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c
new file mode 100644
index 00000000000..bc2901a517e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect2.c
@@ -0,0 +1,122 @@
+/* { dg-do run } */
+
+/* Like imperfect2.c, but enables offloading.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+#pragma omp declare target enter (f1count, f2count)
+#pragma omp declare target enter (g1count, g2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  #pragma omp atomic
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  #pragma omp atomic
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  #pragma omp atomic
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  #pragma omp atomic
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  for (i = 0; i < a1; i++)
+    {
+      f1 (0, i);
+      {
+	g1 (0, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    f1 (1, j);
+	    {
+	      g1 (1, j);
+	      for (k = 0; k < a3; k++)
+		{
+		  f1 (2, k);
+		  {
+		    g1 (2, k);
+		    g2 (2, k);
+		  }
+		  f2 (2, k);
+		}
+	      g2 (1, j);
+	    }
+	  f2 (1, j);
+	  }
+	g2 (0, i);
+      }
+      f2 (0, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c
new file mode 100644
index 00000000000..ddcfcf4b7eb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect3.c
@@ -0,0 +1,125 @@
+/* { dg-do run } */
+
+/* Like imperfect3.c, but enables offloading.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+#pragma omp declare target enter (f1count, f2count)
+#pragma omp declare target enter (g1count, g2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  #pragma omp atomic
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  #pragma omp atomic
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  #pragma omp atomic
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  #pragma omp atomic
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  for (i = 0; i < a1; i++)
+    {
+      int local0 = 0;
+      f1 (local0, i);
+      {
+	g1 (local0, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    int local1 = 1;
+	    f1 (local1, j);
+	    {
+	      g1 (local1, j);
+	      for (k = 0; k < a3; k++)
+		{
+		  int local2 = 2;
+		  f1 (local2, k);
+		  {
+		    g1 (local2, k);
+		    g2 (local2, k);
+		  }
+		  f2 (local2, k);
+		}
+	      g2 (local1, j);
+	    }
+	  f2 (local1, j);
+	  }
+	g2 (local0, i);
+      }
+      f2 (local0, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c
new file mode 100644
index 00000000000..ede488977b8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/offload-imperfect4.c
@@ -0,0 +1,122 @@
+/* { dg-do run } */
+
+/* Like imperfect4.c, but enables offloading.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+#pragma omp declare target enter (f1count, f2count)
+#pragma omp declare target enter (g1count, g2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  #pragma omp atomic
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  #pragma omp atomic
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  #pragma omp atomic
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  #pragma omp atomic
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  for (i = 0; i < a1; i++)
+    {
+      { f1 (0, i); }
+      {
+	g1 (0, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    { f1 (1, j); }
+	    {
+	      { g1 (1, j); }
+	      for (k = 0; k < a3; k++)
+		{
+		  f1 (2, k);
+		  {
+		    g1 (2, k);
+		    g2 (2, k);
+		  }
+		  f2 (2, k);
+		}
+	      { g2 (1, j); }
+	    }
+	    { f2 (1, j); }
+	  }
+	{ g2 (0, i); }
+      }
+      { f2 (0, i); }
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
-- 
2.31.1


^ permalink raw reply	[flat|nested] 7+ messages in thread

* [PATCH 2/3] OpenMP: C++ support for imperfectly-nested loops
  2023-04-28 23:22 [PATCH 0/3] OpenMP: Support imperfectly-nested loops Sandra Loosemore
  2023-04-28 23:22 ` [PATCH 1/3] OpenMP: C support for " Sandra Loosemore
@ 2023-04-28 23:22 ` Sandra Loosemore
  2023-05-25 10:19   ` Jakub Jelinek
  2023-04-28 23:22 ` [PATCH 3/3] OpenMP: Fortran " Sandra Loosemore
  2 siblings, 1 reply; 7+ messages in thread
From: Sandra Loosemore @ 2023-04-28 23:22 UTC (permalink / raw)
  To: gcc-patches

OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop.  In GCC this code is moved
into the inner loop body by the respective front ends.

This patch changes the C++ front end to use recursive descent parsing
on nested loops within an "omp for" construct, rather than an
iterative approach, in order to preserve proper nesting of compound
statements.  Preserving cleanups (destructors) for class objects
declared in intervening code and loop initializers complicates moving
the former into the body of the loop; this is handled by parsing the
entire construct before reassembling any of it.

gcc/cp/ChangeLog
	* cp-tree.h (cp_convert_omp_range_for): Adjust declaration.
	* parser.cc (struct omp_for_parse_data): New.
	(cp_parser_postfix_expression): Diagnose calls to OpenMP runtime
	in intervening code.
	(cp_parser_statement_seq_opt): Special-case nested OMP loops and
	blocks in intervening code.
	(cp_parser_iteration_statement): Reject loops in intervening code.
	(cp_parser_omp_for_loop_init): Expand comments and tweak the
	interface slightly to better distinguish input/output parameters.
	(cp_parser_omp_range_for): Likewise.
	(cp_convert_omp_range_for): Likewise.
	(cp_parser_omp_loop_nest): New, split from cp_parser_omp_for_loop
	and largely rewritten.  Add more comments.
	(struct sit_data, substitute_in_tree_walker, substitute_in_tree):
	New.
	(fixup_blocks_walker): New.
	(cp_parser_omp_for_loop): Rewrite to use recursive descent instead
	of a loop.  Add logic to reshuffle the bits of code collected
	during parsing so intervening code gets moved to the loop body.
	(cp_parser_omp_loop): Remove call to finish_omp_for_block, which
	is now redundant.
	(cp_parser_omp_simd): Likewise.
	(cp_parser_omp_for): Likewise.
	(cp_parser_omp_distribute): Likewise.
	(cp_parser_oacc_loop): Likewise.
	(cp_parser_omp_taskloop): Likewise.
	(cp_parser_pragma): Reject OpenMP pragmas in intervening code.
	* parser.h (struct cp_parser): Add omp_for_parse_state field.
	* pt.cc (tsubst_omp_for_iterator): Adjust call to
	cp_convert_omp_range_for.
	* semantics.cc (struct fofb_data, finish_omp_for_block_walker): New.
	(finish_omp_for_block): Allow variables to be bound in a BIND_EXPR
	nested inside BIND instead of directly in BIND itself.

gcc/testsuite/ChangeLog
	* g++.dg/gomp/pr41967.C: Adjust expected error messages.

libgomp/ChangeLog
	* testsuite/libgomp.c++/imperfect-class-1.C : New.
	* testsuite/libgomp.c++/imperfect-class-2.C : New.
	* testsuite/libgomp.c++/imperfect-class-3.C : New.
	* testsuite/libgomp.c++/imperfect-destructor.C : New.
	* testsuite/libgomp.c++/imperfect-template-1.C : New.
	* testsuite/libgomp.c++/imperfect-template-2.C : New.
	* testsuite/libgomp.c++/imperfect-template-3.C : New.
---
 gcc/cp/cp-tree.h                              |    2 +-
 gcc/cp/parser.cc                              | 1180 ++++++++++++-----
 gcc/cp/parser.h                               |    3 +
 gcc/cp/pt.cc                                  |    3 +-
 gcc/cp/semantics.cc                           |   80 +-
 gcc/testsuite/g++.dg/gomp/pr41967.C           |    2 +-
 .../testsuite/libgomp.c++/imperfect-class-1.C |  169 +++
 .../testsuite/libgomp.c++/imperfect-class-2.C |  167 +++
 .../testsuite/libgomp.c++/imperfect-class-3.C |  167 +++
 .../libgomp.c++/imperfect-destructor.C        |  135 ++
 .../libgomp.c++/imperfect-template-1.C        |  172 +++
 .../libgomp.c++/imperfect-template-2.C        |  170 +++
 .../libgomp.c++/imperfect-template-3.C        |  170 +++
 13 files changed, 2021 insertions(+), 399 deletions(-)
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-1.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-2.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-3.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-destructor.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-1.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-2.C
 create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-3.C

diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index c9c4cd6f32f..90d369e4f65 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -7279,7 +7279,7 @@ extern bool maybe_clone_body			(tree);
 /* In parser.cc */
 extern tree cp_convert_range_for (tree, tree, tree, tree, unsigned int, bool,
 				  unsigned short);
-extern void cp_convert_omp_range_for (tree &, vec<tree, va_gc> *, tree &,
+extern void cp_convert_omp_range_for (tree &, tree &, tree &,
 				      tree &, tree &, tree &, tree &, tree &);
 extern void cp_finish_omp_range_for (tree, tree);
 extern bool parsing_nsdmi (void);
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index d89553e7da8..33656c12138 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -2091,6 +2091,31 @@ struct cp_parser_expression_stack_entry
 typedef struct cp_parser_expression_stack_entry
   cp_parser_expression_stack[NUM_PREC_VALUES];
 
+/* Used for parsing OMP for loops.  */
+struct omp_for_parse_data {
+  tree declv, condv, incrv, initv;
+  tree pre_body;
+  int collapse;
+  int depth;
+  location_t for_loc;
+  releasing_vec init_blockv;
+  releasing_vec body_blockv;
+  releasing_vec init_placeholderv;
+  releasing_vec body_placeholderv;
+  bool want_nested_loop : 1;
+  bool ordered : 1;
+  bool in_intervening_code : 1;
+  bool perfect_nesting_fail : 1;
+  bool fail : 1;
+  bool inscan : 1;
+  enum tree_code code;
+  tree orig_declv;
+  auto_vec<tree, 4> orig_inits;
+  tree clauses;
+  tree *cclauses;
+  tree ordered_cl;
+};
+
 /* Prototypes.  */
 
 /* Constructors and destructors.  */
@@ -2912,6 +2937,7 @@ static bool cp_parser_skip_up_to_closing_square_bracket
 static bool cp_parser_skip_to_closing_square_bracket
   (cp_parser *);
 static size_t cp_parser_skip_balanced_tokens (cp_parser *, size_t);
+static tree cp_parser_omp_loop_nest (cp_parser *, bool *);
 
 // -------------------------------------------------------------------------- //
 // Unevaluated Operand Guard
@@ -7999,12 +8025,22 @@ cp_parser_postfix_expression (cp_parser *parser, bool address_p, bool cast_p,
 				    complain);
 	    else
 	      /* All other function calls.  */
-	      postfix_expression
-		= finish_call_expr (postfix_expression, &args,
-				    /*disallow_virtual=*/false,
-				    koenig_p,
-				    complain);
-
+	      {
+		if (DECL_P (postfix_expression)
+		    && parser->omp_for_parse_state
+		    && parser->omp_for_parse_state->in_intervening_code
+		    && omp_runtime_api_call (postfix_expression))
+		  {
+		    error_at (loc, "Calls to the OpenMP runtime API are "
+				   "not permitted in intervening code");
+		    parser->omp_for_parse_state->fail = true;
+		  }
+		postfix_expression
+		  = finish_call_expr (postfix_expression, &args,
+				      /*disallow_virtual=*/false,
+				      koenig_p,
+				      complain);
+	      }
 	    if (close_paren_loc != UNKNOWN_LOCATION)
 	      postfix_expression.set_location (combined_loc);
 
@@ -12969,6 +13005,15 @@ cp_parser_compound_statement (cp_parser *parser, tree in_statement_expr,
 static void
 cp_parser_statement_seq_opt (cp_parser* parser, tree in_statement_expr)
 {
+  struct omp_for_parse_data *omp_for_parse_state;
+
+  if (parser->omp_for_parse_state
+      && (parser->omp_for_parse_state->depth
+	  < parser->omp_for_parse_state->collapse - 1))
+    omp_for_parse_state = parser->omp_for_parse_state;
+  else
+    omp_for_parse_state = NULL;
+
   /* Scan statements until there aren't any more.  */
   while (true)
     {
@@ -12995,6 +13040,59 @@ cp_parser_statement_seq_opt (cp_parser* parser, tree in_statement_expr)
 	      error_at (token->location, "%<else%> without a previous %<if%>");
 	    }
 	}
+      else if (omp_for_parse_state
+	       && token->type == CPP_KEYWORD && token->keyword == RID_FOR
+	       && omp_for_parse_state->want_nested_loop)
+	{
+	  /* Special treatment for collapsed loop nests.  */
+	  omp_for_parse_state->depth++;
+	  add_stmt (cp_parser_omp_loop_nest (parser, NULL));
+	  omp_for_parse_state->depth--;
+	  continue;
+	}
+      else if (omp_for_parse_state
+	       && token->type != CPP_OPEN_BRACE)
+	{
+	  /* Nested loops can only appear directly or nested in
+	     compound statements.  We have neither, so set the bit
+	     to treat everything inside the subsequent statement
+	     as intervening code instead.  */
+	  bool want_nested_loop = omp_for_parse_state->want_nested_loop;
+	  omp_for_parse_state->want_nested_loop = false;
+
+	  /* Only diagnose errors related to perfect nesting once.  */
+	  if (!omp_for_parse_state->perfect_nesting_fail)
+	    {
+	      if (omp_for_parse_state->code == OACC_LOOP)
+		{
+		  error_at (omp_for_parse_state->for_loc,
+			    "inner loops must be perfectly nested in "
+			    "%<#pragma acc loop%>");
+		  omp_for_parse_state->perfect_nesting_fail = true;
+		}
+	      else if (omp_for_parse_state->ordered)
+		{
+		  error_at (omp_for_parse_state->for_loc,
+			    "inner loops must be perfectly nested with "
+			    "%<ordered%> clause");
+		  omp_for_parse_state->perfect_nesting_fail = true;
+		}
+	      else if (omp_for_parse_state->inscan)
+		{
+		  error_at (omp_for_parse_state->for_loc,
+			    "inner loops must be perfectly nested with "
+			    "%<reduction%> %<inscan%> clause");
+		  omp_for_parse_state->perfect_nesting_fail = true;
+		}
+	      /* TODO: Also reject loops with TILE directive.  */
+	      if (omp_for_parse_state->perfect_nesting_fail)
+		omp_for_parse_state->fail = true;
+	    }
+
+	  cp_parser_statement (parser, in_statement_expr, true, NULL);
+	  omp_for_parse_state->want_nested_loop = want_nested_loop;
+	  continue;
+	}
 
       /* Parse the statement.  */
       cp_parser_statement (parser, in_statement_expr, true, NULL);
@@ -14194,6 +14292,17 @@ cp_parser_iteration_statement (cp_parser* parser, bool *if_p, bool ivdep,
      statement.  */
   in_statement = parser->in_statement;
 
+  /* Special case for OMP loop intervening code.  Parsing of permitted
+     collapsed loop nests is handled elsewhere.  */
+  if (parser->omp_for_parse_state
+      && (parser->omp_for_parse_state->depth
+	  < parser->omp_for_parse_state->collapse - 1))
+    {
+      error_at (token->location,
+		"loop not permitted in intervening code in OMP loop body");
+      parser->omp_for_parse_state->fail = true;
+    }
+
   /* See what kind of keyword it is.  */
   keyword = token->keyword;
   switch (keyword)
@@ -42976,7 +43085,19 @@ cp_parser_omp_for_incr (cp_parser *parser, tree decl)
   return build2 (MODIFY_EXPR, TREE_TYPE (decl), decl, rhs);
 }
 
-/* Parse the initialization statement of an OpenMP for loop.
+/* Parse the initialization statement of an OpenMP for loop.  Range-for
+   is handled separately in cp_convert_omp_range_for.
+
+   On entry SL is the current statement list.  Parsing of some forms
+   of initialization pops this list and stores its contents in either INIT
+   or THIS_PRE_BODY, and sets SL to null.  Initialization for class
+   iterators is added directly to SL and it is not popped until later.
+
+   On return, DECL is set if the initialization is by binding the
+   iteration variable.  If the initialization is by assignment, REAL_DECL
+   is set to point to a variable in an outer scope.  ORIG_INIT is set
+   if the iteration variable is of class type; this is a copy saved for
+   error checking in finish_omp_for.
 
    Return true if the resulting construct should have an
    OMP_CLAUSE_PRIVATE added to it.  */
@@ -42984,7 +43105,7 @@ cp_parser_omp_for_incr (cp_parser *parser, tree decl)
 static tree
 cp_parser_omp_for_loop_init (cp_parser *parser,
 			     tree &this_pre_body,
-			     releasing_vec &for_block,
+			     tree &sl,
 			     tree &init,
 			     tree &orig_init,
 			     tree &decl,
@@ -43082,18 +43203,22 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
 			      asm_specification,
 			      LOOKUP_ONLYCONVERTING);
 	      orig_init = init;
+
+	      /* In the case of a class iterator, do not pop sl here.
+		 Both class initialization and finalization must happen in
+		 the enclosing init block scope.  For now set the init
+		 expression to null; it'll be filled in properly in
+		 finish_omp_for before stuffing it in the OMP_FOR.  */
 	      if (CLASS_TYPE_P (TREE_TYPE (decl)))
+		init = NULL_TREE;
+	      else  /* It is a parameterized type.  */
 		{
-		  vec_safe_push (for_block, this_pre_body);
-		  init = NULL_TREE;
-		}
-	      else
-		{
-		  init = pop_stmt_list (this_pre_body);
+		  init = pop_stmt_list (sl);
+		  sl = NULL_TREE;
 		  if (init && TREE_CODE (init) == STATEMENT_LIST)
 		    {
 		      tree_stmt_iterator i = tsi_start (init);
-		      /* Move lambda DECL_EXPRs to FOR_BLOCK.  */
+		      /* Move lambda DECL_EXPRs to the enclosing block.  */
 		      while (!tsi_end_p (i))
 			{
 			  tree t = tsi_stmt (i);
@@ -43101,7 +43226,7 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
 			      && TREE_CODE (DECL_EXPR_DECL (t)) == TYPE_DECL)
 			    {
 			      tsi_delink (&i);
-			      vec_safe_push (for_block, t);
+			      add_stmt (t);
 			      continue;
 			    }
 			  break;
@@ -43115,9 +43240,10 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
 			}
 		    }
 		}
-	      this_pre_body = NULL_TREE;
 	    }
 	  else
+	    /* This is an initialized declaration of non-class,
+	       non-parameterized type iteration variable.  */
 	    {
 	      /* Consume '='.  */
 	      cp_lexer_consume_token (parser->lexer);
@@ -43131,6 +43257,8 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
 				/*init_const_expr_p=*/false,
 				asm_specification,
 				LOOKUP_ONLYCONVERTING);
+	      this_pre_body = pop_stmt_list (sl);
+	      sl = NULL_TREE;
 	    }
 
 	  if (pushed_scope)
@@ -43202,14 +43330,21 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
 		real_decl = TREE_OPERAND (init, 0);
 	    }
 	}
+      this_pre_body = pop_stmt_list (sl);
+      sl = NULL_TREE;
     }
   return add_private_clause;
 }
 
-/* Helper for cp_parser_omp_for_loop, handle one range-for loop.  */
+/* Helper for cp_parser_omp_loop_nest, handle one range-for loop
+   including introducing new temporaries for the range start and end,
+   doing auto deduction, and processing decomposition variables.
 
+   This function is also called from pt.cc during template instantiation.
+   In that case SL is NULL_TREE, otherwise it is the current statement
+   list.  */
 void
-cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
+cp_convert_omp_range_for (tree &this_pre_body, tree &sl,
 			  tree &decl, tree &orig_decl, tree &init,
 			  tree &orig_init, tree &cond, tree &incr)
 {
@@ -43245,8 +43380,11 @@ cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
       cond = global_namespace;
       incr = NULL_TREE;
       orig_init = init;
-      if (this_pre_body)
-	this_pre_body = pop_stmt_list (this_pre_body);
+      if (sl)
+	{
+	  this_pre_body = pop_stmt_list (sl);
+	  sl = NULL_TREE;
+	}
       return;
     }
 
@@ -43326,11 +43464,7 @@ cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
 
   orig_decl = decl;
   decl = begin;
-  if (for_block)
-    {
-      vec_safe_push (for_block, this_pre_body);
-      this_pre_body = NULL_TREE;
-    }
+  /* Defer popping sl here.  */
 
   tree decomp_first_name = NULL_TREE;
   unsigned decomp_cnt = 0;
@@ -43368,6 +43502,15 @@ cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
 	}
     }
 
+  /* The output ORIG_DECL is not a decl.  Instead, it is a tree structure
+     that holds decls for variables implementing the iterator, represented
+     as a TREE_LIST whose TREE_CHAIN is a vector.  The first two elements
+     of the vector are decls of scratch variables for the range start and
+     end that will eventually be bound in the implicit scope surrounding
+     the whole loop nest.  The remaining elements are decls of derived
+     decomposition variables that are bound inside the loop body.  This
+     structure is further mangled by finish_omp_for into the form required
+     for the OMP_FOR_ORIG_DECLS field of the OMP_FOR tree node.  */
   tree v = make_tree_vec (decomp_cnt + 3);
   TREE_VEC_ELT (v, 0) = range_temp_decl;
   TREE_VEC_ELT (v, 1) = end;
@@ -43622,404 +43765,686 @@ cp_parser_omp_scan_loop_body (cp_parser *parser)
   braces.require_close (parser);
 }
 
-/* Parse the restricted form of the for statement allowed by OpenMP.  */
+
+/* This function parses a single level of a loop nest, invoking itself
+   recursively if necessary.
+
+   loop-nest :: for (...) loop-body
+   loop-body :: loop-nest
+	     |  { [intervening-code] loop-body [intervening-code] }
+	     |  final-loop-body
+   intervening-code :: structured-block-sequence
+   final-loop-body :: structured-block
+
+   For a collapsed loop nest, only a single OMP_FOR is built, pulling out
+   all the iterator information from the inner loops into vectors in the
+   parser->omp_for_parse_state structure.
+
+   In the "range for" case, it is transformed into a regular "for" iterator
+   by introducing some temporary variables for the begin/end,
+   as well as bindings of the actual iteration variables which are
+   injected into the body of the loop.
+
+   Initialization code for iterator variables may end up either in the
+   init vector (simple assignments), in omp_for_parse_state->pre_body
+   (decl_exprs for iterators bound in the for statement), or in the
+   scope surrounding this level of loop initialization.
+
+   The scopes of class iterator variables and their finalizers need to
+   be adjusted after parsing so that all of the initialization happens
+   in a scope surrounding all of the intervening and body code.  For
+   this reason we separately store the initialization and body blocks
+   for each level of loops in the omp_for_parse_state structure and
+   reassemble/reorder them in cp_parser_omp_for.  See additional
+   comments there about the use of placeholders, etc.  */
 
 static tree
-cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses,
-			tree *cclauses, bool *if_p)
-{
-  tree init, orig_init, cond, incr, body, decl, pre_body = NULL_TREE, ret;
-  tree orig_decl;
-  tree real_decl, initv, condv, incrv, declv, orig_declv;
-  tree this_pre_body, cl, ordered_cl = NULL_TREE;
-  location_t loc_first;
-  bool collapse_err = false;
-  int i, collapse = 1, ordered = 0, count, nbraces = 0;
-  releasing_vec for_block;
-  auto_vec<tree, 4> orig_inits;
-  bool tiling = false;
-  bool inscan = false;
+cp_parser_omp_loop_nest (cp_parser *parser, bool *if_p)
+{
+  tree decl, cond, incr, init;
+  tree orig_init, real_decl, orig_decl;
+  tree init_block, body_block;
+  tree init_placeholder, body_placeholder;
+  tree init_scope;
+  tree this_pre_body = NULL_TREE;
+  bool moreloops;
+  unsigned char save_in_statement;
+  tree add_private_clause = NULL_TREE;
+  location_t loc;
+  bool is_range_for = false;
+  tree sl = NULL_TREE;
+  struct omp_for_parse_data *omp_for_parse_state = parser->omp_for_parse_state;
 
-  for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
-    if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE)
-      collapse = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (cl));
-    else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_TILE)
-      {
-	tiling = true;
-	collapse = list_length (OMP_CLAUSE_TILE_LIST (cl));
-      }
-    else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_ORDERED
-	     && OMP_CLAUSE_ORDERED_EXPR (cl))
-      {
-	ordered_cl = cl;
-	ordered = tree_to_shwi (OMP_CLAUSE_ORDERED_EXPR (cl));
-      }
-    else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_REDUCTION
-	     && OMP_CLAUSE_REDUCTION_INSCAN (cl)
-	     && (code == OMP_SIMD || code == OMP_FOR))
-      inscan = true;
+  gcc_assert (omp_for_parse_state);
 
-  if (ordered && ordered < collapse)
-    {
-      error_at (OMP_CLAUSE_LOCATION (ordered_cl),
-		"%<ordered%> clause parameter is less than %<collapse%>");
-      OMP_CLAUSE_ORDERED_EXPR (ordered_cl)
-	= build_int_cst (NULL_TREE, collapse);
-      ordered = collapse;
-    }
+  /* We have already matched the FOR token but not consumed it yet.  */
+  gcc_assert (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR));
+  loc = cp_lexer_consume_token (parser->lexer)->location;
 
-  gcc_assert (tiling || (collapse >= 1 && ordered >= 0));
-  count = ordered ? ordered : collapse;
+  /* Forbid break/continue in the loop initializer, condition, and
+     increment expressions.  */
+  save_in_statement = parser->in_statement;
+  parser->in_statement = IN_OMP_BLOCK;
 
-  declv = make_tree_vec (count);
-  initv = make_tree_vec (count);
-  condv = make_tree_vec (count);
-  incrv = make_tree_vec (count);
-  orig_declv = NULL_TREE;
+  /* We are not in intervening code now.  */
+  omp_for_parse_state->in_intervening_code = false;
 
-  loc_first = cp_lexer_peek_token (parser->lexer)->location;
+  /* Don't create location wrapper nodes within an OpenMP "for"
+     statement.  */
+  auto_suppress_location_wrappers sentinel;
 
-  for (i = 0; i < count; i++)
-    {
-      int bracecount = 0;
-      tree add_private_clause = NULL_TREE;
-      location_t loc;
+  matching_parens parens;
+  if (!parens.require_open (parser))
+    return NULL;
 
-      if (!cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
-	{
-	  if (!collapse_err)
-	    cp_parser_error (parser, "for statement expected");
-	  return NULL;
-	}
-      loc = cp_lexer_consume_token (parser->lexer)->location;
+  init = orig_init = decl = real_decl = orig_decl = NULL_TREE;
 
-      /* Don't create location wrapper nodes within an OpenMP "for"
-	 statement.  */
-      auto_suppress_location_wrappers sentinel;
+  init_placeholder = build_stmt (input_location, EXPR_STMT,
+				 integer_zero_node);
+  vec_safe_push (omp_for_parse_state->init_placeholderv, init_placeholder);
 
-      matching_parens parens;
-      if (!parens.require_open (parser))
-	return NULL;
+  /* The init_block acts as a container for this level of loop goo.  */
+  init_block = push_stmt_list ();
+  vec_safe_push (omp_for_parse_state->init_blockv, init_block);
 
-      init = orig_init = decl = real_decl = orig_decl = NULL_TREE;
-      this_pre_body = push_stmt_list ();
+  /* Wrap a scope around this entire level of loop to hold bindings
+     of loop iteration variables.  We can't insert them directly
+     in the containing scope because that would cause their visibility to
+     be incorrect with respect to intervening code after this loop.
+     We will combine the nested init_scopes in postprocessing after the
+     entire loop is parsed.  */
+  init_scope = begin_compound_stmt (0);
 
-      if (code != OACC_LOOP && cxx_dialect >= cxx11)
-	{
-	  /* Save tokens so that we can put them back.  */
-	  cp_lexer_save_tokens (parser->lexer);
+  /* Now we need another level of statement list container to capture the
+     initialization (and possible finalization) bits.  In some cases this
+     container may be popped off during initializer parsing to store code in
+     INIT or THIS_PRE_BODY, depending on the form of initialization.  If
+     we have a class iterator we will pop it at the end of parsing this
+     level, so the cleanups are handled correctly.  */
+  sl = push_stmt_list ();
 
-	  /* Look for ':' that is not nested in () or {}.  */
-	  bool is_range_for
-	    = (cp_parser_skip_to_closing_parenthesis_1 (parser,
-							/*recovering=*/false,
-							CPP_COLON,
-							/*consume_paren=*/
-							false) == -1);
+  if (omp_for_parse_state->code != OACC_LOOP && cxx_dialect >= cxx11)
+    {
+      /* Save tokens so that we can put them back.  */
+      cp_lexer_save_tokens (parser->lexer);
 
-	  /* Roll back the tokens we skipped.  */
-	  cp_lexer_rollback_tokens (parser->lexer);
+      /* Look for ':' that is not nested in () or {}.  */
+      is_range_for
+	= (cp_parser_skip_to_closing_parenthesis_1 (parser,
+						    /*recovering=*/false,
+						    CPP_COLON,
+						    /*consume_paren=*/
+						    false) == -1);
 
-	  if (is_range_for)
-	    {
-	      bool saved_colon_corrects_to_scope_p
-		= parser->colon_corrects_to_scope_p;
+      /* Roll back the tokens we skipped.  */
+      cp_lexer_rollback_tokens (parser->lexer);
 
-	      /* A colon is used in range-based for.  */
-	      parser->colon_corrects_to_scope_p = false;
+      if (is_range_for)
+	{
+	  bool saved_colon_corrects_to_scope_p
+	    = parser->colon_corrects_to_scope_p;
 
-	      /* Parse the declaration.  */
-	      cp_parser_simple_declaration (parser,
-					    /*function_definition_allowed_p=*/
-					    false, &decl);
-	      parser->colon_corrects_to_scope_p
-		= saved_colon_corrects_to_scope_p;
+	  /* A colon is used in range-based for.  */
+	  parser->colon_corrects_to_scope_p = false;
 
-	      cp_parser_require (parser, CPP_COLON, RT_COLON);
+	  /* Parse the declaration.  */
+	  cp_parser_simple_declaration (parser,
+					/*function_definition_allowed_p=*/
+					false, &decl);
+	  parser->colon_corrects_to_scope_p
+	    = saved_colon_corrects_to_scope_p;
 
-	      init = cp_parser_range_for (parser, NULL_TREE, NULL_TREE, decl,
-					  false, 0, true);
+	  cp_parser_require (parser, CPP_COLON, RT_COLON);
 
-	      cp_convert_omp_range_for (this_pre_body, for_block, decl,
-					orig_decl, init, orig_init,
-					cond, incr);
-	      if (this_pre_body)
-		{
-		  if (pre_body)
-		    {
-		      tree t = pre_body;
-		      pre_body = push_stmt_list ();
-		      add_stmt (t);
-		      add_stmt (this_pre_body);
-		      pre_body = pop_stmt_list (pre_body);
-		    }
-		  else
-		    pre_body = this_pre_body;
-		}
+	  init = cp_parser_range_for (parser, NULL_TREE, NULL_TREE, decl,
+				      false, 0, true);
 
-	      if (ordered_cl)
-		error_at (OMP_CLAUSE_LOCATION (ordered_cl),
-			  "%<ordered%> clause with parameter on "
-			  "range-based %<for%> loop");
+	  cp_convert_omp_range_for (this_pre_body, sl, decl,
+				    orig_decl, init, orig_init,
+				    cond, incr);
 
-	      goto parse_close_paren;
-	    }
+	  if (omp_for_parse_state->ordered_cl)
+	    error_at (OMP_CLAUSE_LOCATION (omp_for_parse_state->ordered_cl),
+		      "%<ordered%> clause with parameter on "
+		      "range-based %<for%> loop");
+
+	  goto parse_close_paren;
 	}
+    }
 
-      add_private_clause
-	= cp_parser_omp_for_loop_init (parser, this_pre_body, for_block,
-				       init, orig_init, decl, real_decl);
+  add_private_clause
+    = cp_parser_omp_for_loop_init (parser, this_pre_body, sl,
+				   init, orig_init, decl, real_decl);
 
-      cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
-      if (this_pre_body)
-	{
-	  this_pre_body = pop_stmt_list (this_pre_body);
-	  if (pre_body)
-	    {
-	      tree t = pre_body;
-	      pre_body = push_stmt_list ();
-	      add_stmt (t);
-	      add_stmt (this_pre_body);
-	      pre_body = pop_stmt_list (pre_body);
-	    }
-	  else
-	    pre_body = this_pre_body;
-	}
+  cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
 
-      if (decl)
-	real_decl = decl;
-      if (cclauses != NULL
-	  && cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL
-	  && real_decl != NULL_TREE
-	  && code != OMP_LOOP)
-	{
-	  tree *c;
-	  for (c = &cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]; *c ; )
-	    if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_FIRSTPRIVATE
-		&& OMP_CLAUSE_DECL (*c) == real_decl)
-	      {
-		error_at (loc, "iteration variable %qD"
-			  " should not be firstprivate", real_decl);
-		*c = OMP_CLAUSE_CHAIN (*c);
-	      }
-	    else if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_LASTPRIVATE
-		     && OMP_CLAUSE_DECL (*c) == real_decl)
+  /* If the iteration variable was introduced via a declaration in the
+     for statement, DECL points at it.  Otherwise DECL is null and
+     REAL_DECL is a variable previously declared in an outer scope.
+     Make REAL_DECL point at the iteration variable no matter where it
+     was introduced.  */
+  if (decl)
+    real_decl = decl;
+
+  /* Some clauses treat iterator variables specially.  */
+  if (omp_for_parse_state->cclauses != NULL
+      && omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL
+      && real_decl != NULL_TREE
+      && omp_for_parse_state->code != OMP_LOOP)
+    {
+      tree *c;
+      for (c = &(omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]);
+	   *c ; )
+	if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_FIRSTPRIVATE
+	    && OMP_CLAUSE_DECL (*c) == real_decl)
+	  {
+	    error_at (loc, "iteration variable %qD"
+		      " should not be firstprivate", real_decl);
+	    *c = OMP_CLAUSE_CHAIN (*c);
+	  }
+	else if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_LASTPRIVATE
+		 && OMP_CLAUSE_DECL (*c) == real_decl)
+	  {
+	    /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES.  */
+	    tree l = *c;
+	    *c = OMP_CLAUSE_CHAIN (*c);
+	    if (omp_for_parse_state->code == OMP_SIMD)
 	      {
-		/* Move lastprivate (decl) clause to OMP_FOR_CLAUSES.  */
-		tree l = *c;
-		*c = OMP_CLAUSE_CHAIN (*c);
-		if (code == OMP_SIMD)
-		  {
-		    OMP_CLAUSE_CHAIN (l) = cclauses[C_OMP_CLAUSE_SPLIT_FOR];
-		    cclauses[C_OMP_CLAUSE_SPLIT_FOR] = l;
-		  }
-		else
-		  {
-		    OMP_CLAUSE_CHAIN (l) = clauses;
-		    clauses = l;
-		  }
-		add_private_clause = NULL_TREE;
+		OMP_CLAUSE_CHAIN (l)
+		  = omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_FOR];
+		omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_FOR] = l;
 	      }
 	    else
 	      {
-		if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_PRIVATE
-		    && OMP_CLAUSE_DECL (*c) == real_decl)
-		  add_private_clause = NULL_TREE;
-		c = &OMP_CLAUSE_CHAIN (*c);
+		OMP_CLAUSE_CHAIN (l) = omp_for_parse_state->clauses;
+		omp_for_parse_state->clauses = l;
 	      }
-	}
+	    add_private_clause = NULL_TREE;
+	  }
+	else
+	  {
+	    if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_PRIVATE
+		&& OMP_CLAUSE_DECL (*c) == real_decl)
+	      add_private_clause = NULL_TREE;
+	    c = &OMP_CLAUSE_CHAIN (*c);
+	  }
+    }
 
-      if (add_private_clause)
+  if (add_private_clause)
+    {
+      tree c;
+      for (c = omp_for_parse_state->clauses; c ; c = OMP_CLAUSE_CHAIN (c))
 	{
-	  tree c;
-	  for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
-	    {
-	      if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE
-		   || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE)
-		  && OMP_CLAUSE_DECL (c) == decl)
-		break;
-	      else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
-		       && OMP_CLAUSE_DECL (c) == decl)
-		error_at (loc, "iteration variable %qD "
-			  "should not be firstprivate",
-			  decl);
-	      else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
-			|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION)
-		       && OMP_CLAUSE_DECL (c) == decl)
-		error_at (loc, "iteration variable %qD should not be reduction",
-			  decl);
-	    }
-	  if (c == NULL)
+	  if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE
+	       || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE)
+	      && OMP_CLAUSE_DECL (c) == decl)
+	    break;
+	  else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
+		   && OMP_CLAUSE_DECL (c) == decl)
+	    error_at (loc, "iteration variable %qD "
+		      "should not be firstprivate",
+		      decl);
+	  else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
+		    || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION)
+		   && OMP_CLAUSE_DECL (c) == decl)
+	    error_at (loc, "iteration variable %qD should not be reduction",
+		      decl);
+	}
+      if (c == NULL)
+	{
+	  if ((omp_for_parse_state->code == OMP_SIMD
+	       && omp_for_parse_state->collapse != 1)
+	      || omp_for_parse_state->code == OMP_LOOP)
+	    c = build_omp_clause (loc, OMP_CLAUSE_LASTPRIVATE);
+	  else if (omp_for_parse_state->code != OMP_SIMD)
+	    c = build_omp_clause (loc, OMP_CLAUSE_PRIVATE);
+	  else
+	    c = build_omp_clause (loc, OMP_CLAUSE_LINEAR);
+	  OMP_CLAUSE_DECL (c) = add_private_clause;
+	  c = finish_omp_clauses (c, C_ORT_OMP);
+	  if (c)
 	    {
-	      if ((code == OMP_SIMD && collapse != 1) || code == OMP_LOOP)
-		c = build_omp_clause (loc, OMP_CLAUSE_LASTPRIVATE);
-	      else if (code != OMP_SIMD)
-		c = build_omp_clause (loc, OMP_CLAUSE_PRIVATE);
-	      else
-		c = build_omp_clause (loc, OMP_CLAUSE_LINEAR);
-	      OMP_CLAUSE_DECL (c) = add_private_clause;
-	      c = finish_omp_clauses (c, C_ORT_OMP);
-	      if (c)
-		{
-		  OMP_CLAUSE_CHAIN (c) = clauses;
-		  clauses = c;
-		  /* For linear, signal that we need to fill up
-		     the so far unknown linear step.  */
-		  if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR)
-		    OMP_CLAUSE_LINEAR_STEP (c) = NULL_TREE;
-		}
+	      OMP_CLAUSE_CHAIN (c) = omp_for_parse_state->clauses;
+	      omp_for_parse_state->clauses = c;
+	      /* For linear, signal that we need to fill up
+		 the so far unknown linear step.  */
+	      if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR)
+		OMP_CLAUSE_LINEAR_STEP (c) = NULL_TREE;
 	    }
 	}
+    }
 
-      cond = NULL;
-      if (cp_lexer_next_token_is_not (parser->lexer, CPP_SEMICOLON))
-	cond = cp_parser_omp_for_cond (parser, decl, code);
-      cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
+  cond = NULL;
+  if (cp_lexer_next_token_is_not (parser->lexer, CPP_SEMICOLON))
+    cond = cp_parser_omp_for_cond (parser, decl, omp_for_parse_state->code);
+  cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
 
-      incr = NULL;
-      if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN))
-	{
-	  /* If decl is an iterator, preserve the operator on decl
-	     until finish_omp_for.  */
-	  if (real_decl
-	      && ((processing_template_decl
-		   && (TREE_TYPE (real_decl) == NULL_TREE
-		       || !INDIRECT_TYPE_P (TREE_TYPE (real_decl))))
-		  || CLASS_TYPE_P (TREE_TYPE (real_decl))))
-	    incr = cp_parser_omp_for_incr (parser, real_decl);
-	  else
-	    incr = cp_parser_expression (parser);
-	  protected_set_expr_location_if_unset (incr, input_location);
-	}
+  incr = NULL;
+  if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN))
+    {
+      /* If decl is an iterator, preserve the operator on decl
+	 until finish_omp_for.  */
+      if (real_decl
+	  && ((processing_template_decl
+	       && (TREE_TYPE (real_decl) == NULL_TREE
+		   || !INDIRECT_TYPE_P (TREE_TYPE (real_decl))))
+	      || CLASS_TYPE_P (TREE_TYPE (real_decl))))
+	incr = cp_parser_omp_for_incr (parser, real_decl);
+      else
+	incr = cp_parser_expression (parser);
+      protected_set_expr_location_if_unset (incr, input_location);
+    }
 
-    parse_close_paren:
-      if (!parens.require_close (parser))
-	cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
-					       /*or_comma=*/false,
-					       /*consume_paren=*/true);
+ parse_close_paren:
+  if (!parens.require_close (parser))
+    cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
+					   /*or_comma=*/false,
+					   /*consume_paren=*/true);
 
-      TREE_VEC_ELT (declv, i) = decl;
-      TREE_VEC_ELT (initv, i) = init;
-      TREE_VEC_ELT (condv, i) = cond;
-      TREE_VEC_ELT (incrv, i) = incr;
-      if (orig_init)
-	{
-	  orig_inits.safe_grow_cleared (i + 1, true);
-	  orig_inits[i] = orig_init;
-	}
-      if (orig_decl)
+  /* We've parsed all the for (...) stuff now.  Store the bits.  */
+  TREE_VEC_ELT (omp_for_parse_state->declv, omp_for_parse_state->depth)
+    = decl;
+  TREE_VEC_ELT (omp_for_parse_state->initv, omp_for_parse_state->depth)
+    = init;
+  TREE_VEC_ELT (omp_for_parse_state->condv, omp_for_parse_state->depth)
+    = cond;
+  TREE_VEC_ELT (omp_for_parse_state->incrv, omp_for_parse_state->depth)
+    = incr;
+  if (orig_init)
+    {
+      int i = omp_for_parse_state->depth;
+      omp_for_parse_state->orig_inits.safe_grow_cleared (i + 1, true);
+      omp_for_parse_state->orig_inits[i] = orig_init;
+    }
+  if (orig_decl)
+    {
+      if (!omp_for_parse_state->orig_declv)
+	omp_for_parse_state->orig_declv
+	  = copy_node (omp_for_parse_state->declv);
+      TREE_VEC_ELT (omp_for_parse_state->orig_declv,
+		    omp_for_parse_state->depth) = orig_decl;
+    }
+  else if (omp_for_parse_state->orig_declv)
+    TREE_VEC_ELT (omp_for_parse_state->orig_declv,
+		  omp_for_parse_state->depth) = decl;
+  if (this_pre_body)
+    append_to_statement_list_force (this_pre_body,
+				    &(omp_for_parse_state->pre_body));
+
+  /* Start a nested block for the loop body.  */
+  body_placeholder = build_stmt (input_location, EXPR_STMT,
+				 integer_zero_node);
+  vec_safe_push (omp_for_parse_state->body_placeholderv, body_placeholder);
+  body_block = push_stmt_list ();
+  vec_safe_push (omp_for_parse_state->body_blockv, body_block);
+
+  omp_for_parse_state->want_nested_loop = true;
+  moreloops = omp_for_parse_state->depth < omp_for_parse_state->collapse - 1;
+  if (moreloops && cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
+    {
+      omp_for_parse_state->depth++;
+      add_stmt (cp_parser_omp_loop_nest (parser, if_p));
+      omp_for_parse_state->depth--;
+    }
+  else if (moreloops
+	   && cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE))
+    {
+      /* This is the open brace in the loop-body grammar production.  Rather
+	 than trying to special-case braces, just parse it as a compound
+	 statement and handle the nested loop-body case there.  Note that
+	 when we see a further open brace inside the compound statement
+	 loop-body, we don't know whether it is the start of intervening
+	 code that is a compound statement, or a level of braces
+	 surrounding a nested loop-body.  Use the WANT_NESTED_LOOP state
+	 bit to ensure we have only one nested loop at each level.  */
+
+      omp_for_parse_state->in_intervening_code = true;
+      cp_parser_compound_statement (parser, NULL, BCS_NORMAL, false);
+      omp_for_parse_state->in_intervening_code = false;
+
+      if (omp_for_parse_state->want_nested_loop)
 	{
-	  if (!orig_declv)
-	    orig_declv = copy_node (declv);
-	  TREE_VEC_ELT (orig_declv, i) = orig_decl;
+	  /* We have already parsed the whole loop body and not found a
+	     nested loop.  */
+	  error_at (omp_for_parse_state->for_loc,
+		    "not enough nested loops");
+	  omp_for_parse_state->fail = true;
 	}
-      else if (orig_declv)
-	TREE_VEC_ELT (orig_declv, i) = decl;
+      if_p = NULL;
+    }
+  else
+    {
+      /* This is the final-loop-body case in the grammar: we have something
+	 that is not a FOR and not an open brace.  */
+      if (moreloops)
+	{
+	  /* If we were expecting a nested loop, give an error and mark
+	     that parsing has failed, and try to recover by parsing the
+	     body as regular code without further collapsing.  */
+	  error_at (omp_for_parse_state->for_loc,
+		    "not enough nested loops");
+	  omp_for_parse_state->fail = true;
+	}
+      parser->in_statement = IN_OMP_FOR;
+
+      /* Generate the parts of range for that belong in the loop body,
+	 to be executed on every iteration.  This includes setting the
+	 user-declared decomposition variables from the compiler-generated
+	 temporaries that are the real iteration variables for OMP_FOR.
+	 FIXME:  Not sure if this is correct with respect to visibility
+	 of the variables from intervening code.  However, putting this
+	 code in each level of loop instead of all around the innermost
+	 body also makes the decomposition variables visible to the
+	 inner for init/bound/step exressions, which is not supposed to
+	 happen and causes test failures.  */
+      if (omp_for_parse_state->orig_declv)
+	for (int i = 0; i < omp_for_parse_state->collapse; i++)
+	  {
+	    tree o = TREE_VEC_ELT (omp_for_parse_state->orig_declv, i);
+	    tree d = TREE_VEC_ELT (omp_for_parse_state->declv, i);
+	    if (o != d)
+	      cp_finish_omp_range_for (o, d);
+	  }
 
-      if (i == count - 1)
-	break;
+      /* Now parse the final-loop-body for the innermost loop.  */
+      if (omp_for_parse_state->inscan)
+	cp_parser_omp_scan_loop_body (parser);
+      else
+	cp_parser_statement (parser, NULL_TREE, false, if_p);
+    }
+  parser->in_statement = save_in_statement;
+  omp_for_parse_state->want_nested_loop = false;
+  omp_for_parse_state->in_intervening_code = true;
+
+  /* Pop and remember the body block.  Add the body placeholder
+     to the surrounding statement list instead.  This is just a unique
+     token that will be replaced when we reassemble the generated
+     code for the entire omp for statement.  */
+  body_block = pop_stmt_list (body_block);
+  omp_for_parse_state->body_blockv[omp_for_parse_state->depth] = body_block;
+  add_stmt (body_placeholder);
+
+  /* Pop and remember the init block.  */
+  if (sl)
+    add_stmt (pop_stmt_list (sl));
+  finish_compound_stmt (init_scope);
+  init_block = pop_stmt_list (init_block);
+  omp_for_parse_state->init_blockv[omp_for_parse_state->depth] = init_block;
+
+  /* Return the init placeholder rather than the remembered init block.
+     Again, this is just a unique cookie that will be used to reassemble
+     code pieces when the entire omp for statement has been parsed.  */
+  return init_placeholder;
+}
+
+/* Helpers used for relinking tree structures: In tree rooted at
+   CONTEXT, replace ORIG with REPLACEMENT.  If FLATTEN is true, try to combine
+   nested BIND_EXPRs.  Gives an assertion if it fails to find ORIG.  */
+
+struct sit_data {
+  tree orig;
+  tree repl;
+  bool flatten;
+};
 
-      /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed
-	 in between the collapsed for loops to be still considered perfectly
-	 nested.  Hopefully the final version clarifies this.
-	 For now handle (multiple) {'s and empty statements.  */
-      cp_parser_parse_tentatively (parser);
-      for (;;)
-	{
-	  if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
-	    break;
-	  else if (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE))
-	    {
-	      cp_lexer_consume_token (parser->lexer);
-	      bracecount++;
-	    }
-	  else if (bracecount
-		   && cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON))
-	    cp_lexer_consume_token (parser->lexer);
-	  else
-	    {
-	      loc = cp_lexer_peek_token (parser->lexer)->location;
-	      error_at (loc, "not enough for loops to collapse");
-	      collapse_err = true;
-	      cp_parser_abort_tentative_parse (parser);
-	      declv = NULL_TREE;
-	      break;
-	    }
-	}
+static tree
+substitute_in_tree_walker (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, void *dp)
+{
+  struct sit_data *sit = (struct sit_data *)dp;
+  if (*tp == sit->orig)
+    {
+      *tp = sit->repl;
+      return *tp;
+    }
+  /* Remove BIND_EXPRs with no bindings even when not specifically
+     trying to flatten.  */
+  else if (TREE_CODE (*tp) == BIND_EXPR
+	   && BIND_EXPR_BODY (*tp) == sit->orig
+	   && !BIND_EXPR_VARS (*tp))
+    {
+      *tp = sit->repl;
+      return *tp;
+    }
+  else if (sit->flatten
+	   && TREE_CODE (*tp) == BIND_EXPR
+	   && TREE_CODE (sit->repl) == BIND_EXPR)
+    {
+      if (BIND_EXPR_BODY (*tp) == sit->orig)
+	{
+	  /* Merge binding lists for two directly nested BIND_EXPRs,
+	     keeping the outer one.  */
+	  BIND_EXPR_VARS (*tp) = chainon (BIND_EXPR_VARS (*tp),
+					  BIND_EXPR_VARS (sit->repl));
+	  BIND_EXPR_BODY (*tp) = BIND_EXPR_BODY (sit->repl);
+	  return *tp;
+	}
+      else if (TREE_CODE (BIND_EXPR_BODY (*tp)) == STATEMENT_LIST)
+	/* There might be a statement list containing cleanup_points
+	   etc between the two levels of BIND_EXPR.  We can still merge
+	   them, again keeping the outer BIND_EXPR.  */
+	for (tree_stmt_iterator i = tsi_start (BIND_EXPR_BODY (*tp));
+	     !tsi_end_p (i); ++i)
+	  {
+	    tree *p = tsi_stmt_ptr (i);
+	    if (*p == sit->orig)
+	      {
+		BIND_EXPR_VARS (*tp) = chainon (BIND_EXPR_VARS (*tp),
+						BIND_EXPR_VARS (sit->repl));
+		*p = BIND_EXPR_BODY (sit->repl);
+		return *tp;
+	      }
+	  }
+    }
+  return NULL;
+}
+
+static void
+substitute_in_tree (tree *context, tree orig, tree repl, bool flatten)
+{
+  struct sit_data data;
+
+  gcc_assert (*context && orig && repl);
+  if (TREE_CODE (repl) == BIND_EXPR && !BIND_EXPR_VARS (repl))
+    repl = BIND_EXPR_BODY (repl);
+  data.orig = orig;
+  data.repl = repl;
+  data.flatten = flatten;
+
+  tree result = cp_walk_tree (context, substitute_in_tree_walker,
+			      (void *)&data, NULL);
+  gcc_assert (result != NULL_TREE);
+}
 
-      if (declv)
+/* Walker to patch up the BLOCK_NODE hierarchy after the above surgery.
+   *DP is is the parent block.  */
+
+static tree
+fixup_blocks_walker (tree *tp, int *walk_subtrees, void *dp)
+{
+  tree superblock = *(tree *)dp;
+
+  if (TREE_CODE (*tp) == BIND_EXPR)
+    {
+      tree block = BIND_EXPR_BLOCK (*tp);
+      if (superblock)
 	{
-	  cp_parser_parse_definitely (parser);
-	  nbraces += bracecount;
+	  BLOCK_SUPERCONTEXT (block) = superblock;
+	  BLOCK_CHAIN (block) = BLOCK_SUBBLOCKS (superblock);
+	  BLOCK_SUBBLOCKS (superblock) = block;
 	}
+      BLOCK_SUBBLOCKS (block) = NULL_TREE;
+      cp_walk_tree (&BIND_EXPR_BODY (*tp), fixup_blocks_walker,
+		    (void *)&block, NULL);
+      *walk_subtrees = 0;
     }
 
-  if (nbraces)
-    if_p = NULL;
+  return NULL;
+}
+
+/* Parse the restricted form of the for statement allowed by OpenMP.  */
 
-  /* Note that we saved the original contents of this flag when we entered
-     the structured block, and so we don't need to re-save it here.  */
-  parser->in_statement = IN_OMP_FOR;
+static tree
+cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses,
+			tree *cclauses, bool *if_p)
+{
+  tree ret;
+  tree cl, ordered_cl = NULL_TREE;
+  location_t loc_first;
+  int collapse = 1, ordered = 0;
+  unsigned int count;
+  bool tiling = false;
+  bool inscan = false;
+  struct omp_for_parse_data data;
+  struct omp_for_parse_data *save_data = parser->omp_for_parse_state;
+  tree result;
 
-  /* Note that the grammar doesn't call for a structured block here,
-     though the loop as a whole is a structured block.  */
-  if (orig_declv)
+  for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
+    if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE)
+      collapse = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (cl));
+    else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_TILE)
+      {
+	tiling = true;
+	collapse = list_length (OMP_CLAUSE_TILE_LIST (cl));
+      }
+    else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_ORDERED
+	     && OMP_CLAUSE_ORDERED_EXPR (cl))
+      {
+	ordered_cl = cl;
+	ordered = tree_to_shwi (OMP_CLAUSE_ORDERED_EXPR (cl));
+      }
+    else if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_REDUCTION
+	     && OMP_CLAUSE_REDUCTION_INSCAN (cl)
+	     && (code == OMP_SIMD || code == OMP_FOR))
+      inscan = true;
+
+  if (ordered && ordered < collapse)
     {
-      body = begin_omp_structured_block ();
-      for (i = 0; i < count; i++)
-	if (TREE_VEC_ELT (orig_declv, i) != TREE_VEC_ELT (declv, i))
-	  cp_finish_omp_range_for (TREE_VEC_ELT (orig_declv, i),
-				   TREE_VEC_ELT (declv, i));
+      error_at (OMP_CLAUSE_LOCATION (ordered_cl),
+		"%<ordered%> clause parameter is less than %<collapse%>");
+      OMP_CLAUSE_ORDERED_EXPR (ordered_cl)
+	= build_int_cst (NULL_TREE, collapse);
+      ordered = collapse;
     }
-  else
-    body = push_stmt_list ();
-  if (inscan)
-    cp_parser_omp_scan_loop_body (parser);
-  else
-    cp_parser_statement (parser, NULL_TREE, false, if_p);
-  if (orig_declv)
-    body = finish_omp_structured_block (body);
-  else
-    body = pop_stmt_list (body);
 
-  if (declv == NULL_TREE)
-    ret = NULL_TREE;
-  else
-    ret = finish_omp_for (loc_first, code, declv, orig_declv, initv, condv,
-			  incrv, body, pre_body, &orig_inits, clauses);
+  gcc_assert (tiling || (collapse >= 1 && ordered >= 0));
+  count = ordered ? ordered : collapse;
 
-  while (nbraces)
+  if (!cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
     {
-      if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE))
-	{
-	  cp_lexer_consume_token (parser->lexer);
-	  nbraces--;
-	}
-      else if (cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON))
-	cp_lexer_consume_token (parser->lexer);
-      else
-	{
-	  if (!collapse_err)
-	    {
-	      error_at (cp_lexer_peek_token (parser->lexer)->location,
-			"collapsed loops not perfectly nested");
-	    }
-	  collapse_err = true;
-	  cp_parser_statement_seq_opt (parser, NULL);
-	  if (cp_lexer_next_token_is (parser->lexer, CPP_EOF))
-	    break;
-	}
+      cp_parser_error (parser, "for statement expected");
+      return NULL;
+    }
+
+  /* FIXME: Inconsistently with the C front end, the C++ front end
+     uses the location of the outermost FOR loop for flagging errors,
+     rather than the location of the OMP FOR directive.  Tweaking this
+     causes many failures in existing C++ test cases due to errors
+     being diagnosed on a different line than expected.  */
+  loc_first = cp_lexer_peek_token (parser->lexer)->location;
+
+  /* Initialize parse state for recursive descent.  */
+  data.declv = make_tree_vec (count);
+  data.initv = make_tree_vec (count);
+  data.condv = make_tree_vec (count);
+  data.incrv = make_tree_vec (count);
+  data.pre_body = NULL_TREE;
+  data.for_loc = loc_first;
+  data.collapse = count;
+  data.depth = 0;
+  data.want_nested_loop = true;
+  data.ordered = ordered > 0;
+  data.in_intervening_code = false;
+  data.perfect_nesting_fail = false;
+  data.fail = false;
+  data.inscan = inscan;
+  data.code = code;
+  data.orig_declv = NULL_TREE;
+  data.clauses = clauses;
+  data.cclauses = cclauses;
+  data.ordered_cl = ordered_cl;
+  parser->omp_for_parse_state = &data;
+
+  cp_parser_omp_loop_nest (parser, if_p);
+
+  /* Bomb out early if there was an error (not enough loops, etc).  */
+  if (data.fail || data.declv == NULL_TREE)
+    {
+      parser->omp_for_parse_state = save_data;
+      return NULL_TREE;
     }
 
-  while (!for_block->is_empty ())
+  /* Relink the init and body blocks that were built during parsing.  At
+     this point we have a structure nested like
+       init 0
+	 body 0
+	   init 1
+	     body 1
+	       init 2
+		 body 2
+     and we want to turn it into
+      init 0
+	 init 1
+	   init 2
+	     omp_for
+	       body 0
+		 body 1
+		   body 2
+     We also need to flatten the init blocks, as some code for later
+     processing of combined directives gets confused otherwise.  */
+
+  gcc_assert (vec_safe_length (data.init_blockv) == count);
+  gcc_assert (vec_safe_length (data.body_blockv) == count);
+  gcc_assert (vec_safe_length (data.init_placeholderv) == count);
+  gcc_assert (vec_safe_length (data.body_placeholderv) == count);
+
+  /* Do the substitution from the inside out.  */
+  for (unsigned int i = count - 1; i > 0; i--)
+    {
+      substitute_in_tree (&(data.body_blockv[i-1]),
+			  data.init_placeholderv[i],
+			  data.body_blockv[i], false);
+      substitute_in_tree (&(data.init_blockv[i-1]),
+			  data.body_placeholderv[i-1],
+			  data.init_blockv[i], true);
+    }
+
+  /* Generate the OMP_FOR.  Note finish_omp_for adds the OMP_FOR
+     (and possibly other stuff) to the current statement list but
+     returns a pointer to the OMP_FOR itself, or null in case of error.  */
+  result = push_stmt_list ();
+  ret = finish_omp_for (loc_first, code, data.declv, data.orig_declv,
+			data.initv, data.condv, data.incrv,
+			data.body_blockv[0],
+			data.pre_body, &data.orig_inits, data.clauses);
+  result = pop_stmt_list (result);
+
+  if (ret)
     {
-      tree t = for_block->pop ();
-      if (TREE_CODE (t) == STATEMENT_LIST)
-	add_stmt (pop_stmt_list (t));
-      else
-	add_stmt (t);
+      /* Splice the omp_for into the nest of init blocks.  */
+      substitute_in_tree (&(data.init_blockv[0]),
+			  data.body_placeholderv[count - 1],
+			  result, true);
+
+      /* Some later processing for combined directives assumes
+	 that the BIND_EXPR containing range for variables appears
+	 at top level in the OMP_FOR body.  Fix that up if it's
+	 not the case, e.g. because there is intervening code.  */
+      if (code != OACC_LOOP)
+	finish_omp_for_block (data.init_blockv[0], ret);
+
+      /* Clean up the block subblock/superblock links.  */
+      if (!processing_template_decl)
+	{
+	  tree superblock = NULL_TREE;
+	  cp_walk_tree (&data.init_blockv[0], fixup_blocks_walker,
+			(void *)&superblock, NULL);
+	}
+
+      /* Finally record the result.  */
+      add_stmt (data.init_blockv[0]);
     }
 
+  parser->omp_for_parse_state = save_data;
   return ret;
 }
 
@@ -44078,7 +44503,7 @@ cp_parser_omp_loop (cp_parser *parser, cp_token *pragma_tok,
   ret = cp_parser_omp_for_loop (parser, OMP_LOOP, clauses, cclauses, if_p);
 
   cp_parser_end_omp_structured_block (parser, save);
-  add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+  add_stmt (finish_omp_structured_block (sb));
 
   return ret;
 }
@@ -44127,7 +44552,7 @@ cp_parser_omp_simd (cp_parser *parser, cp_token *pragma_tok,
   ret = cp_parser_omp_for_loop (parser, OMP_SIMD, clauses, cclauses, if_p);
 
   cp_parser_end_omp_structured_block (parser, save);
-  add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+  add_stmt (finish_omp_structured_block (sb));
 
   return ret;
 }
@@ -44229,7 +44654,7 @@ cp_parser_omp_for (cp_parser *parser, cp_token *pragma_tok,
   ret = cp_parser_omp_for_loop (parser, OMP_FOR, clauses, cclauses, if_p);
 
   cp_parser_end_omp_structured_block (parser, save);
-  add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+  add_stmt (finish_omp_structured_block (sb));
 
   return ret;
 }
@@ -45077,7 +45502,7 @@ cp_parser_omp_distribute (cp_parser *parser, cp_token *pragma_tok,
   ret = cp_parser_omp_for_loop (parser, OMP_DISTRIBUTE, clauses, NULL, if_p);
 
   cp_parser_end_omp_structured_block (parser, save);
-  add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+  add_stmt (finish_omp_structured_block (sb));
 
   return ret;
 }
@@ -46084,7 +46509,15 @@ cp_parser_oacc_loop (cp_parser *parser, cp_token *pragma_tok, char *p_name,
   int save = cp_parser_begin_omp_structured_block (parser);
   tree stmt = cp_parser_omp_for_loop (parser, OACC_LOOP, clauses, NULL, if_p);
   cp_parser_end_omp_structured_block (parser, save);
-  add_stmt (finish_omp_structured_block (block));
+
+  /* Later processing of combined acc loop constructs gets confused
+     by an extra level of empty nested BIND_EXPRs, so flatten them.  */
+  block = finish_omp_structured_block (block);
+  if (TREE_CODE (block) == BIND_EXPR
+      && TREE_CODE (BIND_EXPR_BODY (block)) == BIND_EXPR
+      && !BIND_EXPR_VARS (block))
+    block = BIND_EXPR_BODY (block);
+  add_stmt (block);
 
   return stmt;
 }
@@ -48436,7 +48869,7 @@ cp_parser_omp_taskloop (cp_parser *parser, cp_token *pragma_tok,
 				if_p);
 
   cp_parser_end_omp_structured_block (parser, save);
-  add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+  add_stmt (finish_omp_structured_block (sb));
 
   return ret;
 }
@@ -49211,6 +49644,17 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
   parser->lexer->in_pragma = true;
 
   id = cp_parser_pragma_kind (pragma_tok);
+  if (parser->omp_for_parse_state
+      && parser->omp_for_parse_state->in_intervening_code
+      && id >= PRAGMA_OMP__START_
+      && id <= PRAGMA_OMP__LAST_)
+    {
+      error_at (pragma_tok->location,
+		"intervening code must not contain OpenMP directives");
+      parser->omp_for_parse_state->fail = true;
+      cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+      return false;
+    }
   if (id != PRAGMA_OMP_DECLARE && id != PRAGMA_OACC_ROUTINE)
     cp_ensure_no_omp_declare_simd (parser);
   switch (id)
diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h
index e261d7e16e4..6cbb9a8e031 100644
--- a/gcc/cp/parser.h
+++ b/gcc/cp/parser.h
@@ -435,6 +435,9 @@ struct GTY(()) cp_parser {
      specification, if any, or UNKNOWN_LOCATION otherwise.  */
   location_t innermost_linkage_specification_location;
 
+  /* Pointer to state for parsing omp_loops.  Managed by
+     cp_parser_omp_for_loop in parser.cc and not used outside that file.  */
+  struct omp_for_parse_data * GTY((skip)) omp_for_parse_state;
 };
 
 /* In parser.cc  */
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index 6df16fef0dd..2f1f9235bf2 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -18448,7 +18448,8 @@ tsubst_omp_for_iterator (tree t, int i, tree declv, tree &orig_declv,
       tree this_pre_body = NULL_TREE;
       tree orig_init = NULL_TREE;
       tree orig_decl = NULL_TREE;
-      cp_convert_omp_range_for (this_pre_body, NULL, decl, orig_decl, init,
+      tree init_sl = NULL_TREE;
+      cp_convert_omp_range_for (this_pre_body, init_sl, decl, orig_decl, init,
 				orig_init, cond, incr);
       if (orig_decl)
 	{
diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc
index 9ba316ab3be..8662e4f500d 100644
--- a/gcc/cp/semantics.cc
+++ b/gcc/cp/semantics.cc
@@ -10818,47 +10818,71 @@ finish_omp_for (location_t locus, enum tree_code code, tree declv,
   return omp_for;
 }
 
-/* Fix up range for decls.  Those decls were pushed into BIND's BIND_EXPR_VARS
-   and need to be moved into the BIND_EXPR inside of the OMP_FOR's body.  */
+/* Code walker for finish_omp_for_block: extract binding of DP->var
+   from its current block and move it to a new BIND_EXPR DP->b
+   surrounding the body of DP->omp_for.  */
 
+struct fofb_data {
+  tree var;
+  tree b;
+  tree omp_for;
+};
+
+static tree
+finish_omp_for_block_walker (tree *tp, int *walk_subtrees, void *dp)
+{
+  struct fofb_data *fofb = (struct fofb_data *)dp;
+  if (TREE_CODE (*tp) == BIND_EXPR)
+    for (tree *p = &BIND_EXPR_VARS (*tp); *p; p = &DECL_CHAIN (*p))
+      {
+	if (*p == fofb->var)
+	  {
+	    *p = DECL_CHAIN (*p);
+	    if (fofb->b == NULL_TREE)
+	      {
+		fofb->b = make_node (BLOCK);
+		fofb->b = build3 (BIND_EXPR, void_type_node, NULL_TREE,
+			    OMP_FOR_BODY (fofb->omp_for), fofb->b);
+		TREE_SIDE_EFFECTS (fofb->b) = 1;
+		OMP_FOR_BODY (fofb->omp_for) = fofb->b;
+	      }
+	    DECL_CHAIN (fofb->var) = BIND_EXPR_VARS (fofb->b);
+	    BIND_EXPR_VARS (fofb->b) = fofb->var;
+	    BLOCK_VARS (BIND_EXPR_BLOCK (fofb->b)) = fofb->var;
+	    BLOCK_VARS (BIND_EXPR_BLOCK (*tp)) = BIND_EXPR_VARS (*tp);
+	    return *tp;
+	  }
+      }
+  if (TREE_CODE (*tp) != BIND_EXPR && TREE_CODE (*tp) != STATEMENT_LIST)
+    *walk_subtrees = false;
+  return NULL_TREE;
+}
+
+/* Fix up range for decls.  Those decls were pushed into BIND's
+   BIND_EXPR_VARS, or that of a nested BIND_EXPR inside its body,
+   and need to be moved into a new BIND_EXPR surrounding OMP_FOR's body
+   so that processing of combined loop directives can find them.  */
 tree
 finish_omp_for_block (tree bind, tree omp_for)
 {
   if (omp_for == NULL_TREE
       || !OMP_FOR_ORIG_DECLS (omp_for)
-      || bind == NULL_TREE
-      || TREE_CODE (bind) != BIND_EXPR)
+      || bind == NULL_TREE)
     return bind;
-  tree b = NULL_TREE;
+  struct fofb_data fofb;
+  fofb.b = NULL_TREE;
+  fofb.omp_for = omp_for;
   for (int i = 0; i < TREE_VEC_LENGTH (OMP_FOR_INIT (omp_for)); i++)
     if (TREE_CODE (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i)) == TREE_LIST
 	&& TREE_CHAIN (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i)))
       {
 	tree v = TREE_CHAIN (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i));
-	gcc_assert (BIND_EXPR_BLOCK (bind)
-		    && (BIND_EXPR_VARS (bind)
-			== BLOCK_VARS (BIND_EXPR_BLOCK (bind))));
 	for (int j = 2; j < TREE_VEC_LENGTH (v); j++)
-	  for (tree *p = &BIND_EXPR_VARS (bind); *p; p = &DECL_CHAIN (*p))
-	    {
-	      if (*p == TREE_VEC_ELT (v, j))
-		{
-		  tree var = *p;
-		  *p = DECL_CHAIN (*p);
-		  if (b == NULL_TREE)
-		    {
-		      b = make_node (BLOCK);
-		      b = build3 (BIND_EXPR, void_type_node, NULL_TREE,
-				  OMP_FOR_BODY (omp_for), b);
-		      TREE_SIDE_EFFECTS (b) = 1;
-		      OMP_FOR_BODY (omp_for) = b;
-		    }
-		  DECL_CHAIN (var) = BIND_EXPR_VARS (b);
-		  BIND_EXPR_VARS (b) = var;
-		  BLOCK_VARS (BIND_EXPR_BLOCK (b)) = var;
-		}
-	    }
-	BLOCK_VARS (BIND_EXPR_BLOCK (bind)) = BIND_EXPR_VARS (bind);
+	  {
+	    fofb.var = TREE_VEC_ELT (v, j);
+	    cp_walk_tree (&bind, finish_omp_for_block_walker,
+			  (void *)&fofb, NULL);
+	  }
       }
   return bind;
 }
diff --git a/gcc/testsuite/g++.dg/gomp/pr41967.C b/gcc/testsuite/g++.dg/gomp/pr41967.C
index 0eb489e8bee..7b59f831fe0 100644
--- a/gcc/testsuite/g++.dg/gomp/pr41967.C
+++ b/gcc/testsuite/g++.dg/gomp/pr41967.C
@@ -11,7 +11,7 @@ foo ()
     {
       for (int j = 0; j < 5; ++j)
 	++sum;
-      ++sum;	// { dg-error "collapsed loops not perfectly nested" }
+      ++sum;
     }
   return sum;
 }
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-1.C b/libgomp/testsuite/libgomp.c++/imperfect-class-1.C
new file mode 100644
index 00000000000..3c39c42c107
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-class-1.C
@@ -0,0 +1,169 @@
+// { dg-do run }
+// Test that class iterators and imperfectly-nested loops work together.
+// This variant tests initialization by assignment.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+typedef int T;
+typedef int S;
+
+class I
+{
+public:
+  typedef ptrdiff_t difference_type;
+  I ();
+  ~I ();
+  I (T *);
+  I (const I &);
+  T &operator * ();
+  T *operator -> ();
+  T &operator [] (const difference_type &) const;
+  I &operator = (const I &);
+  I &operator ++ ();
+  I operator ++ (int);
+  I &operator -- ();
+  I operator -- (int);
+  I &operator += (const difference_type &);
+  I &operator -= (const difference_type &);
+  I operator + (const difference_type &) const;
+  I operator - (const difference_type &) const;
+  friend bool operator == (I &, I &);
+  friend bool operator == (const I &, const I &);
+  friend bool operator < (I &, I &);
+  friend bool operator < (const I &, const I &);
+  friend bool operator <= (I &, I &);
+  friend bool operator <= (const I &, const I &);
+  friend bool operator > (I &, I &);
+  friend bool operator > (const I &, const I &);
+  friend bool operator >= (I &, I &);
+  friend bool operator >= (const I &, const I &);
+  friend typename I::difference_type operator - (I &, I &);
+  friend typename I::difference_type operator - (const I &, const I &);
+  friend I operator + (typename I::difference_type , const I &);
+private:
+  T *p;
+};
+ I::I () : p (0) {}
+ I::~I () { p = (T *) 0; }
+ I::I (T *x) : p (x) {}
+ I::I (const I &x) : p (x.p) {}
+ T &I::operator * () { return *p; }
+ T *I::operator -> () { return p; }
+ T &I::operator [] (const difference_type &x) const { return p[x]; }
+ I &I::operator = (const I &x) { p = x.p; return *this; }
+ I &I::operator ++ () { ++p; return *this; }
+ I I::operator ++ (int) { return I (p++); }
+ I &I::operator -- () { --p; return *this; }
+ I I::operator -- (int) { return I (p--); }
+ I &I::operator += (const difference_type &x) { p += x; return *this; }
+ I &I::operator -= (const difference_type &x) { p -= x; return *this; }
+ I I::operator + (const difference_type &x) const { return I (p + x); }
+ I I::operator - (const difference_type &x) const { return I (p - x); }
+ bool operator == (I &x, I &y) { return x.p == y.p; }
+ bool operator == (const I &x, const I &y) { return x.p == y.p; }
+ bool operator != (I &x, I &y) { return !(x == y); }
+ bool operator != (const I &x, const I &y) { return !(x == y); }
+ bool operator < (I &x, I &y) { return x.p < y.p; }
+ bool operator < (const I &x, const I &y) { return x.p < y.p; }
+ bool operator <= (I &x, I &y) { return x.p <= y.p; }
+ bool operator <= (const I &x, const I &y) { return x.p <= y.p; }
+ bool operator > (I &x, I &y) { return x.p > y.p; }
+ bool operator > (const I &x, const I &y) { return x.p > y.p; }
+ bool operator >= (I &x, I &y) { return x.p >= y.p; }
+ bool operator >= (const I &x, const I &y) { return x.p >= y.p; }
+ typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; }
+ typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; }
+ I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); }
+
+class J
+{
+ public:
+ J(const I &x, const I &y) : b (x), e (y) {}
+ const I &begin ();
+ const I &end ();
+ private:
+ I b, e;
+};
+
+const I &J::begin () { return b; }
+const I &J::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+  f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+  f2count[depth]++;
+}
+
+void s1 (J a1, J a2, J a3)
+{
+  I i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = a1.begin (); i < a1.end (); i++)
+    {
+      f1 (0);
+      for (j = a2.begin (); j < a2.end (); j++)
+	{
+	  f1 (1);
+	  for (k = a3.begin (); k < a3.end (); k++)
+	    {
+	      f1 (2);
+	      f2 (2);
+	    }
+	  f2 (1);
+	}
+      f2 (0);
+    }
+}
+
+
+int
+main (void)
+{
+
+  int index[] = {0, 1, 2, 3, 4, 5};
+
+  J x (&index[0], &index[3]);
+  J y (&index[0], &index[4]);
+  J z (&index[0], &index[5]);
+
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1 (x, y, z);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-2.C b/libgomp/testsuite/libgomp.c++/imperfect-class-2.C
new file mode 100644
index 00000000000..c6b657cabba
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-class-2.C
@@ -0,0 +1,167 @@
+// { dg-do run }
+// Test that class iterators and imperfectly-nested loops work together.
+// This variant tests loop initialization by declaration.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+typedef int T;
+typedef int S;
+
+class I
+{
+public:
+  typedef ptrdiff_t difference_type;
+  I ();
+  ~I ();
+  I (T *);
+  I (const I &);
+  T &operator * ();
+  T *operator -> ();
+  T &operator [] (const difference_type &) const;
+  I &operator = (const I &);
+  I &operator ++ ();
+  I operator ++ (int);
+  I &operator -- ();
+  I operator -- (int);
+  I &operator += (const difference_type &);
+  I &operator -= (const difference_type &);
+  I operator + (const difference_type &) const;
+  I operator - (const difference_type &) const;
+  friend bool operator == (I &, I &);
+  friend bool operator == (const I &, const I &);
+  friend bool operator < (I &, I &);
+  friend bool operator < (const I &, const I &);
+  friend bool operator <= (I &, I &);
+  friend bool operator <= (const I &, const I &);
+  friend bool operator > (I &, I &);
+  friend bool operator > (const I &, const I &);
+  friend bool operator >= (I &, I &);
+  friend bool operator >= (const I &, const I &);
+  friend typename I::difference_type operator - (I &, I &);
+  friend typename I::difference_type operator - (const I &, const I &);
+  friend I operator + (typename I::difference_type , const I &);
+private:
+  T *p;
+};
+ I::I () : p (0) {}
+ I::~I () { p = (T *) 0; }
+ I::I (T *x) : p (x) {}
+ I::I (const I &x) : p (x.p) {}
+ T &I::operator * () { return *p; }
+ T *I::operator -> () { return p; }
+ T &I::operator [] (const difference_type &x) const { return p[x]; }
+ I &I::operator = (const I &x) { p = x.p; return *this; }
+ I &I::operator ++ () { ++p; return *this; }
+ I I::operator ++ (int) { return I (p++); }
+ I &I::operator -- () { --p; return *this; }
+ I I::operator -- (int) { return I (p--); }
+ I &I::operator += (const difference_type &x) { p += x; return *this; }
+ I &I::operator -= (const difference_type &x) { p -= x; return *this; }
+ I I::operator + (const difference_type &x) const { return I (p + x); }
+ I I::operator - (const difference_type &x) const { return I (p - x); }
+ bool operator == (I &x, I &y) { return x.p == y.p; }
+ bool operator == (const I &x, const I &y) { return x.p == y.p; }
+ bool operator != (I &x, I &y) { return !(x == y); }
+ bool operator != (const I &x, const I &y) { return !(x == y); }
+ bool operator < (I &x, I &y) { return x.p < y.p; }
+ bool operator < (const I &x, const I &y) { return x.p < y.p; }
+ bool operator <= (I &x, I &y) { return x.p <= y.p; }
+ bool operator <= (const I &x, const I &y) { return x.p <= y.p; }
+ bool operator > (I &x, I &y) { return x.p > y.p; }
+ bool operator > (const I &x, const I &y) { return x.p > y.p; }
+ bool operator >= (I &x, I &y) { return x.p >= y.p; }
+ bool operator >= (const I &x, const I &y) { return x.p >= y.p; }
+ typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; }
+ typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; }
+ I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); }
+
+class J
+{
+ public:
+ J(const I &x, const I &y) : b (x), e (y) {}
+ const I &begin ();
+ const I &end ();
+ private:
+ I b, e;
+};
+
+const I &J::begin () { return b; }
+const I &J::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+  f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+  f2count[depth]++;
+}
+
+void s1 (J a1, J a2, J a3)
+{
+#pragma omp for collapse(3)
+  for (I i = a1.begin (); i < a1.end (); i++)
+    {
+      f1 (0);
+      for (I j = a2.begin (); j < a2.end (); j++)
+	{
+	  f1 (1);
+	  for (I k = a3.begin (); k < a3.end (); k++)
+	    {
+	      f1 (2);
+	      f2 (2);
+	    }
+	  f2 (1);
+	}
+      f2 (0);
+    }
+}
+
+
+int
+main (void)
+{
+
+  int index[] = {0, 1, 2, 3, 4, 5};
+
+  J x (&index[0], &index[3]);
+  J y (&index[0], &index[4]);
+  J z (&index[0], &index[5]);
+
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1 (x, y, z);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-3.C b/libgomp/testsuite/libgomp.c++/imperfect-class-3.C
new file mode 100644
index 00000000000..c33826a6b36
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-class-3.C
@@ -0,0 +1,167 @@
+// { dg-do run }
+// Test that class iterators and imperfectly-nested loops work together.
+// This variant tests range for.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+typedef int T;
+typedef int S;
+
+class I
+{
+public:
+  typedef ptrdiff_t difference_type;
+  I ();
+  ~I ();
+  I (T *);
+  I (const I &);
+  T &operator * ();
+  T *operator -> ();
+  T &operator [] (const difference_type &) const;
+  I &operator = (const I &);
+  I &operator ++ ();
+  I operator ++ (int);
+  I &operator -- ();
+  I operator -- (int);
+  I &operator += (const difference_type &);
+  I &operator -= (const difference_type &);
+  I operator + (const difference_type &) const;
+  I operator - (const difference_type &) const;
+  friend bool operator == (I &, I &);
+  friend bool operator == (const I &, const I &);
+  friend bool operator < (I &, I &);
+  friend bool operator < (const I &, const I &);
+  friend bool operator <= (I &, I &);
+  friend bool operator <= (const I &, const I &);
+  friend bool operator > (I &, I &);
+  friend bool operator > (const I &, const I &);
+  friend bool operator >= (I &, I &);
+  friend bool operator >= (const I &, const I &);
+  friend typename I::difference_type operator - (I &, I &);
+  friend typename I::difference_type operator - (const I &, const I &);
+  friend I operator + (typename I::difference_type , const I &);
+private:
+  T *p;
+};
+ I::I () : p (0) {}
+ I::~I () { p = (T *) 0; }
+ I::I (T *x) : p (x) {}
+ I::I (const I &x) : p (x.p) {}
+ T &I::operator * () { return *p; }
+ T *I::operator -> () { return p; }
+ T &I::operator [] (const difference_type &x) const { return p[x]; }
+ I &I::operator = (const I &x) { p = x.p; return *this; }
+ I &I::operator ++ () { ++p; return *this; }
+ I I::operator ++ (int) { return I (p++); }
+ I &I::operator -- () { --p; return *this; }
+ I I::operator -- (int) { return I (p--); }
+ I &I::operator += (const difference_type &x) { p += x; return *this; }
+ I &I::operator -= (const difference_type &x) { p -= x; return *this; }
+ I I::operator + (const difference_type &x) const { return I (p + x); }
+ I I::operator - (const difference_type &x) const { return I (p - x); }
+ bool operator == (I &x, I &y) { return x.p == y.p; }
+ bool operator == (const I &x, const I &y) { return x.p == y.p; }
+ bool operator != (I &x, I &y) { return !(x == y); }
+ bool operator != (const I &x, const I &y) { return !(x == y); }
+ bool operator < (I &x, I &y) { return x.p < y.p; }
+ bool operator < (const I &x, const I &y) { return x.p < y.p; }
+ bool operator <= (I &x, I &y) { return x.p <= y.p; }
+ bool operator <= (const I &x, const I &y) { return x.p <= y.p; }
+ bool operator > (I &x, I &y) { return x.p > y.p; }
+ bool operator > (const I &x, const I &y) { return x.p > y.p; }
+ bool operator >= (I &x, I &y) { return x.p >= y.p; }
+ bool operator >= (const I &x, const I &y) { return x.p >= y.p; }
+ typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; }
+ typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; }
+ I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); }
+
+class J
+{
+ public:
+ J(const I &x, const I &y) : b (x), e (y) {}
+ const I &begin ();
+ const I &end ();
+ private:
+ I b, e;
+};
+
+const I &J::begin () { return b; }
+const I &J::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+  f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+  f2count[depth]++;
+}
+
+void s1 (J a1, J a2, J a3)
+{
+#pragma omp for collapse(3)
+  for (auto i : a1)
+    {
+      f1 (0);
+      for (auto j : a2)
+	{
+	  f1 (1);
+	  for (auto k : a3)
+	    {
+	      f1 (2);
+	      f2 (2);
+	    }
+	  f2 (1);
+	}
+      f2 (0);
+    }
+}
+
+
+int
+main (void)
+{
+
+  int index[] = {0, 1, 2, 3, 4, 5};
+
+  J x (&index[0], &index[3]);
+  J y (&index[0], &index[4]);
+  J z (&index[0], &index[5]);
+
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1 (x, y, z);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-destructor.C b/libgomp/testsuite/libgomp.c++/imperfect-destructor.C
new file mode 100644
index 00000000000..bd87760e076
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-destructor.C
@@ -0,0 +1,135 @@
+/* { dg-do run } */
+
+/* Make sure destructors are called for class variables bound
+   in intervening code.  */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+static int ccount[3], dcount[3];
+
+class C {
+ public:
+  int n;
+  C (int nn) { n = nn; ccount[n]++; }
+  ~C () { dcount[n]++; n = 0; }
+};
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+  f1count[depth]++;
+  return iter;
+}
+
+int f2 (int depth, int iter)
+{
+  f2count[depth]++;
+  return iter;
+}
+
+int g1 (int depth, int iter)
+{
+  g1count[depth]++;
+  return iter;
+}
+
+int g2 (int depth, int iter)
+{
+  g2count[depth]++;
+  return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+  int i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = 0; i < a1; i++)
+    {
+      C local0(0);
+      f1 (local0.n, i);
+      {
+	g1 (local0.n, i);
+	for (j = 0; j < a2; j++)
+	  {
+	    C local1(1);
+	    f1 (local1.n, j);
+	    {
+	      g1 (local1.n, j);
+	      for (k = 0; k < a3; k++)
+		{
+		  C local2(2);
+		  f1 (local2.n, k);
+		  {
+		    g1 (local2.n, k);
+		    g2 (local2.n, k);
+		  }
+		  f2 (local2.n, k);
+		}
+	      g2 (local1.n, j);
+	    }
+	  f2 (local1.n, j);
+	  }
+	g2 (local0.n, i);
+      }
+      f2 (local0.n, i);
+    }
+}
+
+int
+main (void)
+{
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  g1count[0] = 0;
+  g1count[1] = 0;
+  g1count[2] = 0;
+  g2count[0] = 0;
+  g2count[1] = 0;
+  g2count[2] = 0;
+
+  s1 (3, 4, 5);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+  if (g1count[0] != f1count[0]) abort ();
+  if (g2count[0] != f1count[0]) abort ();
+  if (g1count[1] != f1count[1]) abort ();
+  if (g2count[1] != f1count[1]) abort ();
+  if (g1count[2] != f1count[2]) abort ();
+  if (g2count[2] != f1count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+
+  /* Check that each class object declared in intervening code was
+     constructed and destructed an equal number of times.  */
+  if (ccount[0] != dcount[0]) abort ();
+  if (ccount[1] != dcount[1]) abort ();
+  if (ccount[2] != dcount[2]) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-1.C b/libgomp/testsuite/libgomp.c++/imperfect-template-1.C
new file mode 100644
index 00000000000..4ed96c8319b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-template-1.C
@@ -0,0 +1,172 @@
+// { dg-do run }
+// Test that template class iterators and imperfectly-nested loops
+// work together.
+// This variant tests initialization by assignment.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+extern "C" void abort ();
+
+template <typename T>
+class I
+{
+public:
+  typedef ptrdiff_t difference_type;
+  I ();
+  ~I ();
+  I (T *);
+  I (const I &);
+  T &operator * ();
+  T *operator -> ();
+  T &operator [] (const difference_type &) const;
+  I &operator = (const I &);
+  I &operator ++ ();
+  I operator ++ (int);
+  I &operator -- ();
+  I operator -- (int);
+  I &operator += (const difference_type &);
+  I &operator -= (const difference_type &);
+  I operator + (const difference_type &) const;
+  I operator - (const difference_type &) const;
+  template <typename S> friend bool operator == (I<S> &, I<S> &);
+  template <typename S> friend bool operator == (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator < (I<S> &, I<S> &);
+  template <typename S> friend bool operator < (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator <= (I<S> &, I<S> &);
+  template <typename S> friend bool operator <= (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator > (I<S> &, I<S> &);
+  template <typename S> friend bool operator > (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator >= (I<S> &, I<S> &);
+  template <typename S> friend bool operator >= (const I<S> &, const I<S> &);
+  template <typename S> friend typename I<S>::difference_type operator - (I<S> &, I<S> &);
+  template <typename S> friend typename I<S>::difference_type operator - (const I<S> &, const I<S> &);
+  template <typename S> friend I<S> operator + (typename I<S>::difference_type , const I<S> &);
+private:
+  T *p;
+};
+template <typename T> I<T>::I () : p (0) {}
+template <typename T> I<T>::~I () { p = (T *) 0; }
+template <typename T> I<T>::I (T *x) : p (x) {}
+template <typename T> I<T>::I (const I &x) : p (x.p) {}
+template <typename T> T &I<T>::operator * () { return *p; }
+template <typename T> T *I<T>::operator -> () { return p; }
+template <typename T> T &I<T>::operator [] (const difference_type &x) const { return p[x]; }
+template <typename T> I<T> &I<T>::operator = (const I &x) { p = x.p; return *this; }
+template <typename T> I<T> &I<T>::operator ++ () { ++p; return *this; }
+template <typename T> I<T> I<T>::operator ++ (int) { return I (p++); }
+template <typename T> I<T> &I<T>::operator -- () { --p; return *this; }
+template <typename T> I<T> I<T>::operator -- (int) { return I (p--); }
+template <typename T> I<T> &I<T>::operator += (const difference_type &x) { p += x; return *this; }
+template <typename T> I<T> &I<T>::operator -= (const difference_type &x) { p -= x; return *this; }
+template <typename T> I<T> I<T>::operator + (const difference_type &x) const { return I (p + x); }
+template <typename T> I<T> I<T>::operator - (const difference_type &x) const { return I (p - x); }
+template <typename T> bool operator == (I<T> &x, I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator == (const I<T> &x, const I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator != (I<T> &x, I<T> &y) { return !(x == y); }
+template <typename T> bool operator != (const I<T> &x, const I<T> &y) { return !(x == y); }
+template <typename T> bool operator < (I<T> &x, I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator < (const I<T> &x, const I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator <= (I<T> &x, I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator <= (const I<T> &x, const I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator > (I<T> &x, I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator > (const I<T> &x, const I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator >= (I<T> &x, I<T> &y) { return x.p >= y.p; }
+template <typename T> bool operator >= (const I<T> &x, const I<T> &y) { return x.p >= y.p; }
+template <typename T> typename I<T>::difference_type operator - (I<T> &x, I<T> &y) { return x.p - y.p; }
+template <typename T> typename I<T>::difference_type operator - (const I<T> &x, const I<T> &y) { return x.p - y.p; }
+template <typename T> I<T> operator + (typename I<T>::difference_type x, const I<T> &y) { return I<T> (x + y.p); }
+
+template <typename T>
+class J
+{
+public:
+  J(const I<T> &x, const I<T> &y) : b (x), e (y) {}
+  const I<T> &begin ();
+  const I<T> &end ();
+private:
+  I<T> b, e;
+};
+
+template <typename T> const I<T> &J<T>::begin () { return b; }
+template <typename T> const I<T> &J<T>::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+  f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+  f2count[depth]++;
+}
+
+template <typename T>
+void s1 (J<T> a1, J<T> a2, J<T> a3)
+{
+  I<T> i, j, k;
+
+#pragma omp for collapse(3)
+  for (i = a1.begin (); i < a1.end (); i++)
+    {
+      f1 (0);
+      for (j = a2.begin (); j < a2.end (); j++)
+	{
+	  f1 (1);
+	  for (k = a3.begin (); k < a3.end (); k++)
+	    {
+	      f1 (2);
+	      f2 (2);
+	    }
+	  f2 (1);
+	}
+      f2 (0);
+    }
+}
+
+
+int
+main (void)
+{
+
+  int index[] = {0, 1, 2, 3, 4, 5};
+
+  J<int> x (&index[0], &index[3]);
+  J<int> y (&index[0], &index[4]);
+  J<int> z (&index[0], &index[5]);
+
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1<int> (x, y, z);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-2.C b/libgomp/testsuite/libgomp.c++/imperfect-template-2.C
new file mode 100644
index 00000000000..a41c87c481f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-template-2.C
@@ -0,0 +1,170 @@
+// { dg-do run }
+// Test that template class iterators and imperfectly-nested loops
+// work together.
+// This variant tests initialization by declaration.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+extern "C" void abort ();
+
+template <typename T>
+class I
+{
+public:
+  typedef ptrdiff_t difference_type;
+  I ();
+  ~I ();
+  I (T *);
+  I (const I &);
+  T &operator * ();
+  T *operator -> ();
+  T &operator [] (const difference_type &) const;
+  I &operator = (const I &);
+  I &operator ++ ();
+  I operator ++ (int);
+  I &operator -- ();
+  I operator -- (int);
+  I &operator += (const difference_type &);
+  I &operator -= (const difference_type &);
+  I operator + (const difference_type &) const;
+  I operator - (const difference_type &) const;
+  template <typename S> friend bool operator == (I<S> &, I<S> &);
+  template <typename S> friend bool operator == (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator < (I<S> &, I<S> &);
+  template <typename S> friend bool operator < (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator <= (I<S> &, I<S> &);
+  template <typename S> friend bool operator <= (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator > (I<S> &, I<S> &);
+  template <typename S> friend bool operator > (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator >= (I<S> &, I<S> &);
+  template <typename S> friend bool operator >= (const I<S> &, const I<S> &);
+  template <typename S> friend typename I<S>::difference_type operator - (I<S> &, I<S> &);
+  template <typename S> friend typename I<S>::difference_type operator - (const I<S> &, const I<S> &);
+  template <typename S> friend I<S> operator + (typename I<S>::difference_type , const I<S> &);
+private:
+  T *p;
+};
+template <typename T> I<T>::I () : p (0) {}
+template <typename T> I<T>::~I () { p = (T *) 0; }
+template <typename T> I<T>::I (T *x) : p (x) {}
+template <typename T> I<T>::I (const I &x) : p (x.p) {}
+template <typename T> T &I<T>::operator * () { return *p; }
+template <typename T> T *I<T>::operator -> () { return p; }
+template <typename T> T &I<T>::operator [] (const difference_type &x) const { return p[x]; }
+template <typename T> I<T> &I<T>::operator = (const I &x) { p = x.p; return *this; }
+template <typename T> I<T> &I<T>::operator ++ () { ++p; return *this; }
+template <typename T> I<T> I<T>::operator ++ (int) { return I (p++); }
+template <typename T> I<T> &I<T>::operator -- () { --p; return *this; }
+template <typename T> I<T> I<T>::operator -- (int) { return I (p--); }
+template <typename T> I<T> &I<T>::operator += (const difference_type &x) { p += x; return *this; }
+template <typename T> I<T> &I<T>::operator -= (const difference_type &x) { p -= x; return *this; }
+template <typename T> I<T> I<T>::operator + (const difference_type &x) const { return I (p + x); }
+template <typename T> I<T> I<T>::operator - (const difference_type &x) const { return I (p - x); }
+template <typename T> bool operator == (I<T> &x, I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator == (const I<T> &x, const I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator != (I<T> &x, I<T> &y) { return !(x == y); }
+template <typename T> bool operator != (const I<T> &x, const I<T> &y) { return !(x == y); }
+template <typename T> bool operator < (I<T> &x, I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator < (const I<T> &x, const I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator <= (I<T> &x, I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator <= (const I<T> &x, const I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator > (I<T> &x, I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator > (const I<T> &x, const I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator >= (I<T> &x, I<T> &y) { return x.p >= y.p; }
+template <typename T> bool operator >= (const I<T> &x, const I<T> &y) { return x.p >= y.p; }
+template <typename T> typename I<T>::difference_type operator - (I<T> &x, I<T> &y) { return x.p - y.p; }
+template <typename T> typename I<T>::difference_type operator - (const I<T> &x, const I<T> &y) { return x.p - y.p; }
+template <typename T> I<T> operator + (typename I<T>::difference_type x, const I<T> &y) { return I<T> (x + y.p); }
+
+template <typename T>
+class J
+{
+public:
+  J(const I<T> &x, const I<T> &y) : b (x), e (y) {}
+  const I<T> &begin ();
+  const I<T> &end ();
+private:
+  I<T> b, e;
+};
+
+template <typename T> const I<T> &J<T>::begin () { return b; }
+template <typename T> const I<T> &J<T>::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+  f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+  f2count[depth]++;
+}
+
+template <typename T>
+void s1 (J<T> a1, J<T> a2, J<T> a3)
+{
+#pragma omp for collapse(3)
+  for (I<T> i = a1.begin (); i < a1.end (); i++)
+    {
+      f1 (0);
+      for (I<T> j = a2.begin (); j < a2.end (); j++)
+	{
+	  f1 (1);
+	  for (I<T> k = a3.begin (); k < a3.end (); k++)
+	    {
+	      f1 (2);
+	      f2 (2);
+	    }
+	  f2 (1);
+	}
+      f2 (0);
+    }
+}
+
+
+int
+main (void)
+{
+
+  int index[] = {0, 1, 2, 3, 4, 5};
+
+  J<int> x (&index[0], &index[3]);
+  J<int> y (&index[0], &index[4]);
+  J<int> z (&index[0], &index[5]);
+
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1<int> (x, y, z);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-3.C b/libgomp/testsuite/libgomp.c++/imperfect-template-3.C
new file mode 100644
index 00000000000..2e464ed5510
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-template-3.C
@@ -0,0 +1,170 @@
+// { dg-do run }
+// Test that template class iterators and imperfectly-nested loops
+// work together.
+// This variant tests range for syntax.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+extern "C" void abort ();
+
+template <typename T>
+class I
+{
+public:
+  typedef ptrdiff_t difference_type;
+  I ();
+  ~I ();
+  I (T *);
+  I (const I &);
+  T &operator * ();
+  T *operator -> ();
+  T &operator [] (const difference_type &) const;
+  I &operator = (const I &);
+  I &operator ++ ();
+  I operator ++ (int);
+  I &operator -- ();
+  I operator -- (int);
+  I &operator += (const difference_type &);
+  I &operator -= (const difference_type &);
+  I operator + (const difference_type &) const;
+  I operator - (const difference_type &) const;
+  template <typename S> friend bool operator == (I<S> &, I<S> &);
+  template <typename S> friend bool operator == (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator < (I<S> &, I<S> &);
+  template <typename S> friend bool operator < (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator <= (I<S> &, I<S> &);
+  template <typename S> friend bool operator <= (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator > (I<S> &, I<S> &);
+  template <typename S> friend bool operator > (const I<S> &, const I<S> &);
+  template <typename S> friend bool operator >= (I<S> &, I<S> &);
+  template <typename S> friend bool operator >= (const I<S> &, const I<S> &);
+  template <typename S> friend typename I<S>::difference_type operator - (I<S> &, I<S> &);
+  template <typename S> friend typename I<S>::difference_type operator - (const I<S> &, const I<S> &);
+  template <typename S> friend I<S> operator + (typename I<S>::difference_type , const I<S> &);
+private:
+  T *p;
+};
+template <typename T> I<T>::I () : p (0) {}
+template <typename T> I<T>::~I () { p = (T *) 0; }
+template <typename T> I<T>::I (T *x) : p (x) {}
+template <typename T> I<T>::I (const I &x) : p (x.p) {}
+template <typename T> T &I<T>::operator * () { return *p; }
+template <typename T> T *I<T>::operator -> () { return p; }
+template <typename T> T &I<T>::operator [] (const difference_type &x) const { return p[x]; }
+template <typename T> I<T> &I<T>::operator = (const I &x) { p = x.p; return *this; }
+template <typename T> I<T> &I<T>::operator ++ () { ++p; return *this; }
+template <typename T> I<T> I<T>::operator ++ (int) { return I (p++); }
+template <typename T> I<T> &I<T>::operator -- () { --p; return *this; }
+template <typename T> I<T> I<T>::operator -- (int) { return I (p--); }
+template <typename T> I<T> &I<T>::operator += (const difference_type &x) { p += x; return *this; }
+template <typename T> I<T> &I<T>::operator -= (const difference_type &x) { p -= x; return *this; }
+template <typename T> I<T> I<T>::operator + (const difference_type &x) const { return I (p + x); }
+template <typename T> I<T> I<T>::operator - (const difference_type &x) const { return I (p - x); }
+template <typename T> bool operator == (I<T> &x, I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator == (const I<T> &x, const I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator != (I<T> &x, I<T> &y) { return !(x == y); }
+template <typename T> bool operator != (const I<T> &x, const I<T> &y) { return !(x == y); }
+template <typename T> bool operator < (I<T> &x, I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator < (const I<T> &x, const I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator <= (I<T> &x, I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator <= (const I<T> &x, const I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator > (I<T> &x, I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator > (const I<T> &x, const I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator >= (I<T> &x, I<T> &y) { return x.p >= y.p; }
+template <typename T> bool operator >= (const I<T> &x, const I<T> &y) { return x.p >= y.p; }
+template <typename T> typename I<T>::difference_type operator - (I<T> &x, I<T> &y) { return x.p - y.p; }
+template <typename T> typename I<T>::difference_type operator - (const I<T> &x, const I<T> &y) { return x.p - y.p; }
+template <typename T> I<T> operator + (typename I<T>::difference_type x, const I<T> &y) { return I<T> (x + y.p); }
+
+template <typename T>
+class J
+{
+public:
+  J(const I<T> &x, const I<T> &y) : b (x), e (y) {}
+  const I<T> &begin ();
+  const I<T> &end ();
+private:
+  I<T> b, e;
+};
+
+template <typename T> const I<T> &J<T>::begin () { return b; }
+template <typename T> const I<T> &J<T>::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+  f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+  f2count[depth]++;
+}
+
+template <typename T>
+void s1 (J<T> a1, J<T> a2, J<T> a3)
+{
+#pragma omp for collapse(3)
+  for (auto i : a1)
+    {
+      f1 (0);
+      for (auto j : a2)
+	{
+	  f1 (1);
+	  for (auto k : a3)
+	    {
+	      f1 (2);
+	      f2 (2);
+	    }
+	  f2 (1);
+	}
+      f2 (0);
+    }
+}
+
+
+int
+main (void)
+{
+
+  int index[] = {0, 1, 2, 3, 4, 5};
+
+  J<int> x (&index[0], &index[3]);
+  J<int> y (&index[0], &index[4]);
+  J<int> z (&index[0], &index[5]);
+
+  f1count[0] = 0;
+  f1count[1] = 0;
+  f1count[2] = 0;
+  f2count[0] = 0;
+  f2count[1] = 0;
+  f2count[2] = 0;
+
+  s1<int> (x, y, z);
+
+  /* All intervening code at the same depth must be executed the same
+     number of times. */
+  if (f1count[0] != f2count[0]) abort ();
+  if (f1count[1] != f2count[1]) abort ();
+  if (f1count[2] != f2count[2]) abort ();
+
+  /* Intervening code must be executed at least as many times as the loop
+     that encloses it. */
+  if (f1count[0] < 3) abort ();
+  if (f1count[1] < 3 * 4) abort ();
+
+  /* Intervening code must not be executed more times than the number
+     of logical iterations. */
+  if (f1count[0] > 3 * 4 * 5) abort ();
+  if (f1count[1] > 3 * 4 * 5) abort ();
+
+  /* Check that the innermost loop body is executed exactly the number
+     of logical iterations expected. */
+  if (f1count[2] != 3 * 4 * 5) abort ();
+}
-- 
2.31.1


^ permalink raw reply	[flat|nested] 7+ messages in thread

* [PATCH 3/3] OpenMP: Fortran support for imperfectly-nested loops
  2023-04-28 23:22 [PATCH 0/3] OpenMP: Support imperfectly-nested loops Sandra Loosemore
  2023-04-28 23:22 ` [PATCH 1/3] OpenMP: C support for " Sandra Loosemore
  2023-04-28 23:22 ` [PATCH 2/3] OpenMP: C++ " Sandra Loosemore
@ 2023-04-28 23:22 ` Sandra Loosemore
  2 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-04-28 23:22 UTC (permalink / raw)
  To: gcc-patches

OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop.  In GCC this code is moved
into the inner loop body by the respective front ends.

In the Fortran front end, most of the semantic processing happens during
the translation phase, so the parse phase just collects the intervening
statements, checks them for errors, and splices them around the loop body.

gcc/fortran/ChangeLog
	* openmp.cc: Include omp-api.h.
	(resolve_omp_clauses): Consolidate inscan reduction clause conflict
	checking here.
	(find_nested_loop_in_chain): New.
	(find_nested_loop_in_block): New.
	(gfc_resolve_omp_do_blocks): Set omp_current_do_collapse properly.
	Handle imperfectly-nested loops when looking for nested omp scan.
	Refactor to move inscan reduction clause conflict checking to
	resolve_omp_clauses.
	(gfc_resolve_do_iterator): Handle imperfectly-nested loops.
	(struct icode_error_state): New.
	(icode_code_error_callback): New.
	(icode_expr_error_callback): New.
	(diagnose_intervening_code_errors_1): New.
	(diagnose_intervening_code_errors): New.
	(restructure_intervening_code): New.
	(is_outer_iteration_variable): Do not assume loops are perfectly
	nested.
	(expr_is_invariant): Likewise.
	(resolve_omp_do): Handle imperfectly-nested loops.

gcc/testsuite/ChangeLog
	* gfortran.dg/gomp/collapse1.f90: Adjust expected errors.
	* gfortran.dg/gomp/collapse2.f90: Likewise.
	* gfortran.dg/gomp/imperfect1.f90: New.
	* gfortran.dg/gomp/imperfect2.f90: New.
	* gfortran.dg/gomp/imperfect3.f90: New.
	* gfortran.dg/gomp/imperfect4.f90: New.
	* gfortran.dg/gomp/imperfect5.f90: New.

libgomp/ChangeLog
	* testsuite/libgomp.fortran/imperfect-destructor.f90: New.
	* testsuite/libgomp.fortran/imperfect1.f90: New.
	* testsuite/libgomp.fortran/imperfect2.f90: New.
	* testsuite/libgomp.fortran/imperfect3.f90: New.
	* testsuite/libgomp.fortran/imperfect4.f90: New.
	* testsuite/libgomp.fortran/offload-imperfect1.f90: New.
	* testsuite/libgomp.fortran/offload-imperfect2.f90: New.
	* testsuite/libgomp.fortran/offload-imperfect3.f90: New.
	* testsuite/libgomp.fortran/offload-imperfect4.f90: New.
---
 gcc/fortran/openmp.cc                         | 590 +++++++++++++++---
 gcc/testsuite/gfortran.dg/gomp/collapse1.f90  |   6 +-
 gcc/testsuite/gfortran.dg/gomp/collapse2.f90  |  10 +-
 gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 |  39 ++
 gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 |  56 ++
 gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 |  29 +
 gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 |  36 ++
 gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 |  67 ++
 .../libgomp.fortran/imperfect-destructor.f90  | 142 +++++
 .../testsuite/libgomp.fortran/imperfect1.f90  |  67 ++
 .../testsuite/libgomp.fortran/imperfect2.f90  | 102 +++
 .../testsuite/libgomp.fortran/imperfect3.f90  | 110 ++++
 .../testsuite/libgomp.fortran/imperfect4.f90  | 121 ++++
 .../libgomp.fortran/offload-imperfect1.f90    |  72 +++
 .../libgomp.fortran/offload-imperfect2.f90    | 110 ++++
 .../libgomp.fortran/offload-imperfect3.f90    | 116 ++++
 .../libgomp.fortran/offload-imperfect4.f90    | 126 ++++
 17 files changed, 1697 insertions(+), 102 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect1.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect4.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 86e451531a6..25c4c07138d 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 *);
@@ -7209,15 +7210,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
@@ -9033,68 +9043,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);
@@ -9224,13 +9280,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))
@@ -9269,20 +9324,332 @@ 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 OMP 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 OMP 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 OMP 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;
+}
+
+/* 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 collapse)
+{
+  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 (collapse == 1)
+	    innermost_loop = code;
+	  else
+	    innermost_loop
+	      = restructure_intervening_code (&(code->block->next),
+					      code, collapse - 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,
+					    collapse);
+
+	  /* 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.  Splice the two parts
+     around the existing body of the innermost loop.  */
+  if (head != code)
+    {
+      if (innermost_loop->block->next)
+	gfc_append_code (head, innermost_loop->block->next);
+      innermost_loop->block->next = head;
+    }
+  if (tail)
+    {
+      if (innermost_loop->block->next)
+	gfc_append_code (innermost_loop->block->next, tail);
+      else
+	innermost_loop->block->next = tail;
+    }
+
+  /* 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;
 }
@@ -9293,14 +9660,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;
 }
@@ -9371,12 +9739,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;
+  gfc_code *do_code, *next;
   int list, i, collapse;
   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)
     {
@@ -9495,26 +9865,33 @@ resolve_omp_do (gfc_code *code)
   for (i = 1; i <= collapse; 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
@@ -9533,13 +9910,13 @@ 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 (!bound_expr_is_canonical (code, i,
 					 do_code->ext.iterator->start,
@@ -9547,7 +9924,7 @@ 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 (!bound_expr_is_canonical (code, i,
 					 do_code->ext.iterator->end,
@@ -9555,48 +9932,73 @@ 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 (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;
 	}
       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 == collapse)
 	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, collapse);
 }
 
 
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/imperfect1.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
new file mode 100644
index 00000000000..a718e2711dc
--- /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 "OMP 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..b741b05f2f4
--- /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 "OMP 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 "OMP 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/offload-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect1.f90
new file mode 100644
index 00000000000..608eee7e424
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/offload-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/offload-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect2.f90
new file mode 100644
index 00000000000..982661c278a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/offload-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/offload-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect3.f90
new file mode 100644
index 00000000000..6f4f92d6f3f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/offload-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/offload-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/offload-imperfect4.f90
new file mode 100644
index 00000000000..59ec0e92b05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/offload-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
-- 
2.31.1


^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: [PATCH 1/3] OpenMP: C support for imperfectly-nested loops
  2023-04-28 23:22 ` [PATCH 1/3] OpenMP: C support for " Sandra Loosemore
@ 2023-05-25 10:00   ` Jakub Jelinek
  2023-06-14 22:41     ` Sandra Loosemore
  0 siblings, 1 reply; 7+ messages in thread
From: Jakub Jelinek @ 2023-05-25 10:00 UTC (permalink / raw)
  To: Sandra Loosemore; +Cc: gcc-patches

On Fri, Apr 28, 2023 at 05:22:52PM -0600, Sandra Loosemore wrote:
> OpenMP 5.0 removed the restriction that multiple collapsed loops must
> be perfectly nested, allowing "intervening code" (including nested
> BLOCKs) before or after each nested loop.  In GCC this code is moved
> into the inner loop body by the respective front ends.
> 
> This patch changes the C front end to use recursive descent parsing
> on nested loops within an "omp for" construct, rather than an iterative
> approach, in order to preserve proper nesting of compound statements.
> 
> gcc/c/ChangeLog
> 	* c-parser.cc (struct c_parser): Add omp_for_parse_state field.
> 	(struct omp_for_parse_data): New.
> 	(c_parser_compound_statement_nostart): Special-case nested
> 	OMP loops and blocks in intervening code.
> 	(c_parser_while_statement): Reject in intervening code.
> 	(c_parser_do_statement): Likewise.
> 	(c_parser_for_statement): Likewise.
> 	(c_parser_postfix_expression_after_primary): Reject calls to OMP
> 	runtime routines in intervening code.
> 	(c_parser_pragma): Reject OMP pragmas in intervening code.
> 	(c_parser_omp_loop_nest): New, split from c_parser_omp_for_loop.
> 	(c_parser_omp_for_loop): Rewrite to use recursive descent and
> 	generalize handling for intervening code.
> 
> gcc/ChangeLog
> 	* omp-api.h: New file.

Why?  Just add those to omp-general.h.

> 	* omp-general.cc (omp_runtime_api_procname): New.
> 	(omp_runtime_api_call): Moved here from omp-low.cc, and make
> 	non-static.
> 	* omp-general.h: Include omp-api.h.
> 	* omp-low.cc (omp_runtime_api_call): Delete this copy.
> 
> gcc/testsuite/ChangeLog
> 	* c-c++-common/goacc/collapse-1.c: Adjust expected error messages.
> 	* c-c++-common/goacc/tile-2.c: Likewise.
> 	* c-c++-common/gomp/imperfect1.c: New.
> 	* c-c++-common/gomp/imperfect2.c: New.
> 	* c-c++-common/gomp/imperfect3.c: New.
> 	* c-c++-common/gomp/imperfect4.c: New.
> 	* c-c++-common/gomp/imperfect5.c: New.
> 	* gcc.dg/gomp/collapse-1.c: Adjust expected error messages.
> 
> libgomp/ChangeLog
> 	* testsuite/libgomp.c-c++-common/imperfect1.c: New.
> 	* testsuite/libgomp.c-c++-common/imperfect2.c: New.
> 	* testsuite/libgomp.c-c++-common/imperfect3.c: New.
> 	* testsuite/libgomp.c-c++-common/imperfect4.c: New.
> 	* testsuite/libgomp.c-c++-common/imperfect5.c: New.
> 	* testsuite/libgomp.c-c++-common/imperfect6.c: New.
> 	* testsuite/libgomp.c-c++-common/offload-imperfect1.c: New.
> 	* testsuite/libgomp.c-c++-common/offload-imperfect2.c: New.
> 	* testsuite/libgomp.c-c++-common/offload-imperfect3.c: New.
> 	* testsuite/libgomp.c-c++-common/offload-imperfect4.c: New.

If the 3 patches are going to be committed separately (which I think is a
good idea), then the *c-c++-common* tests are a problem, because the tests
will then fail after the C FE part is committed before the C++ FE part is
committed.
For the new tests there are 2 options, one is commit them in the C patch
with /* { dg-do run { target c } } */ instead of just
/* { dg-do run } */ etc. and then in the second patch remove those
" { target c }" parts, or commit them in the second patch only.
For the existing tests with adjustments, do the { target c } vs.
{ target c++ } games and tweak in the second patch.

The offload-imperfect* tests should be called target-imperfect* I think,
for consistency with other tests.

In the gcc/testsuite/c-c++-common/gomp/ tests I miss some coverage for
the boundary cases what is and isn't intervening code.
Before your changes, we were allowing multiple levels of {}s,
so
#pragma omp for ordered(2)
for (int i = 0; i < 64; i++)
  {
    {
      {
        for (int j = 0; j < 64; j++)
          ;
      }
    }
  }
which is valid in 5.0 (but should be tested in the testsuite), but also
empty statements, which when reading the 5.1/5.2 spec don't actually seem to
be valid.
#pragma omp for ordered(2)
for (int i = 0; i < 64; i++)
  {
    ;
    ;
    ;
    for (int j = 0; j < 64; j++)
      ;
    ;
  }
because even the empty statement is I think intervening code according to
the grammar.

Another thing I don't really see covered in the testsuite nor in the code
is if some variable declared in intervening code is then used in the inner
loop's init/cond/incr expressions.  I mean something like:
#pragma omp for collapse(2)
for (int i = 0; i < 64; i++)
  {
    int v = (i + 4) * 2;
    for (int j = v; j < 64; j++)
      ;
  }
That just ICEs with your patch, we should diagnose it as invalid.
In the canonical loop form requirements the standard requires that the
expressions are loop invariant with the exceptions of specific cases
allowed for non-rectangular loops.  So, above I'm sure that is violated.
Another case would be
#pragma omp for collapse(2)
for (int i = 0; i < 64; i++)
  {
    int v = (i + 4);
    for (int j = v; j < 64; j++)
      ;
  }
but here it isn't invariant either, although for (int j = i + 4; j < 64; j++)
would be valid non-rectangular loop I think it requires the exact syntax.
Yet another case is
#pragma omp for collapse(2)
for (int i = 0; i < 64; i++)
  {
    int v = 8;
    for (int j = v; j < 64; j++)
      ;
  }
This actually is loop invariant (the value) and not really sure what would
in the standard prevent it from being valid, but it doesn't feel right and
can't be handled easily, because one should be able to compute the number
of iterations before the loop where v isn't in scope or there could be a
different v in scope.
And/or for C++
#pragma omp for collapse(2)
for (int i = 0; i < 64; i++)
  {
    const int v = 8; // or even constexpr
    for (int j = v; j < 64; j++)
      ;
  }
where already during parsing we won't really know we are actually using v
if it isn't ODR used.  Or unless it is in a template and the const/constexpr
variable is value or type dependent.
I think we want to discuss this in omp-lang.

> @@ -1525,6 +1529,23 @@ struct oacc_routine_data {
>  /* Used for parsing objc foreach statements.  */
>  static tree objc_foreach_break_label, objc_foreach_continue_label;
>  
> +/* Used for parsing OMP for loops.  See c_parser_omp_for_loop.  */
> +struct omp_for_parse_data {
> +  tree declv, condv, incrv, initv;
> +  tree pre_body;
> +  tree bindings;
> +  int collapse;

I think it is confusing to call this collapse when it isn't collapse
but ordered ? ordered : collapse.
Call it count like in c_parser_omp_for_loop?

> @@ -6123,6 +6145,15 @@ c_parser_compound_statement_nostart (c_parser *parser)
>    bool last_label = false;
>    bool save_valid_for_pragma = valid_location_for_stdc_pragma_p ();
>    location_t label_loc = UNKNOWN_LOCATION;  /* Quiet warning.  */
> +  struct omp_for_parse_data *omp_for_parse_state;
> +
> +  if (parser->omp_for_parse_state
> +      && (parser->omp_for_parse_state->depth
> +	  < parser->omp_for_parse_state->collapse - 1))
> +    omp_for_parse_state = parser->omp_for_parse_state;
> +  else
> +    omp_for_parse_state = NULL;
> +
>    if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
>      {
>        location_t endloc = c_parser_peek_token (parser)->location;

So, here we skip over various cases that need to be covered in the testcases
and decided what to do about.
The first one is:
#pragma omp for collapse(2)
for (int i = 0; i < 64; ++i)
  {
    __label__ a, b;
    goto a; a:;
    for (int j = 0; j < 64; ++j)
      ;
    goto b; b:;
  }
This is a GNU extension, do we want to allow it?
Conceptually it is like variable declarations which can appear in
intervening code, but we need to make sure it is handled properly
(the code registers those in the current scope using declare_label, so
supposedly we want to move those later to the body scope when moving there
other intervening code.  And probably it should be rejected when intervening
code is not allowed (+ test for that).

Next are C2X standard attributes, case XX:/default: (I think these would
violate the single entry single exit requirements of intervening code),
label: (that can be fine as long as it is only jumped to from within the
same intervening code), so again something for the testsuite:
int k = 0;
#pragma omp for collapse(2)
for (int i = 0; i < 64; ++i)
  {
    a: if (k) goto a;
    for (int j = 0; j < 64; ++j)
      ;
    b: if (k) goto b;
  }
Then __extension__, again something that should be considered whether it
acts as intervening code, or is even allowed as if it wasn't intervening
code + testsuite coverage.
Then pragmas which you handle in c_parser_pragma already (but will need some
tweaks for tile/unroll from Frederik).
else is an error, so nothing needs to be done about it.

> @@ -7138,6 +7223,16 @@ c_parser_while_statement (c_parser *parser, bool ivdep, unsigned short unroll,
>    gcc_assert (c_parser_next_token_is_keyword (parser, RID_WHILE));
>    token_indent_info while_tinfo
>      = get_token_indent_info (c_parser_peek_token (parser));
> +
> +  if (parser->omp_for_parse_state
> +      && (parser->omp_for_parse_state->depth
> +	  < parser->omp_for_parse_state->collapse - 1))
> +    {
> +      error_at (c_parser_peek_token (parser)->location,
> +		"loop not permitted in intervening code in OMP loop body");

Please use OpenMP in diagnostics rather than OMP (multiple times).
Also, the while and do cases are not covered in the testsuite, they should
be (there is just test for for in there).
Would be nice to also test it nested in other compound statements, like
#pragma omp for collapse(2)
for (int i = 0; i < 64; ++i)
  {
    if (1)
      {
	for (int j = 0; j < 64; ++j)	// { dg-error "..." }
	  ;
	while (0) ;			// { dg-error "..." }
	do { } while (0);		// { dg-error "..." }
      }
    for (int k = 0; k < 64; ++k)
      ;
  }
I guess especially the do { ... } while (0); limitation could be quite
harmful, that is something used heavily in various macros.
So perhaps for OpenMP 6.0 we should consider there rejecting just
for statements for C/C++?  And/or also allow for loops if inside of some
substatement of say if/do/while/switch, those are also clearly
distinguishable from the main loop.  On the other side, I've never been
really excited by this imperfectly nested loops mess making it into the
standard.

> +      parser->omp_for_parse_state->fail = true;
> +    }
> +
>    c_parser_consume_token (parser);
>    block = c_begin_compound_stmt (flag_isoc99);
>    loc = c_parser_peek_token (parser)->location;
> @@ -11234,6 +11349,14 @@ c_parser_postfix_expression_after_primary (c_parser *parser,
>  		  && fndecl_built_in_p (expr.value, BUILT_IN_NORMAL)
>  		  && vec_safe_length (exprlist) == 1)
>  		warn_for_abs (expr_loc, expr.value, (*exprlist)[0]);
> +	      if (parser->omp_for_parse_state
> +		  && parser->omp_for_parse_state->in_intervening_code
> +		  && omp_runtime_api_call (expr.value))
> +		{
> +		  error_at (expr_loc, "Calls to the OpenMP runtime API are "

s/Calls/calls/, C/C++ FE/middle end diagnostics never start with capital
letter unless it is part of some shorthand/word always spelled with capital
letters.

> +				      "not permitted in intervening code");
> +		  parser->omp_for_parse_state->fail = true;
> +		}
>  	    }
>  
>  	  start = expr.get_start ();

> +  if (decl == NULL || decl == error_mark_node || init == error_mark_node)
> +    omp_for_parse_state->fail = true;
> +  else
> +    {
> +      TREE_VEC_ELT (omp_for_parse_state->declv, omp_for_parse_state->depth)
> +	= decl;
> +      TREE_VEC_ELT (omp_for_parse_state->initv, omp_for_parse_state->depth)
> +	= init;
> +      TREE_VEC_ELT (omp_for_parse_state->condv, omp_for_parse_state->depth)
> +	= cond;
> +      TREE_VEC_ELT (omp_for_parse_state->incrv, omp_for_parse_state->depth)
> +	= incr;

This would be more readable using a temporary:
      int depth = omp_for_parse_state->depth;
      TREE_VEC_ELT (omp_for_parse_state->declv, depth) = decl;
      TREE_VEC_ELT (omp_for_parse_state->initv, depth) = init;
      TREE_VEC_ELT (omp_for_parse_state->condv, depth) = cond;
      TREE_VEC_ELT (omp_for_parse_state->incrv, depth) = incr;

> +    }
> +
> +parse_next:
> +  omp_for_parse_state->want_nested_loop = true;
> +  moreloops = omp_for_parse_state->depth < omp_for_parse_state->collapse - 1;

Shouldn't omp_for_parse_state->want_nested_loop be initialized to moreloops
here?

> +  if (moreloops && c_parser_next_token_is_keyword (parser, RID_FOR))
> +    {
> +      omp_for_parse_state->depth++;
> +      body = c_parser_omp_loop_nest (parser, if_p);
> +      omp_for_parse_state->depth--;
> +    }
> +  else if (moreloops && c_parser_next_token_is (parser, CPP_OPEN_BRACE))
> +    {
> +      /* This is the open brace in the loop-body grammar production.  Rather
> +	 than trying to special-case braces, just parse it as a compound
> +	 statement and handle the nested loop-body case there.  Note that
> +	 when we see a further open brace inside the compound statement
> +	 loop-body, we don't know whether it is the start of intervening
> +	 code that is a compound statement, or a level of braces
> +	 surrounding a nested loop-body.  Use the WANT_NESTED_LOOP state
> +	 bit to ensure we have only one nested loop at each level.  */
> +      omp_for_parse_state->in_intervening_code = true;
> +      body = c_parser_compound_statement (parser, NULL);
> +      omp_for_parse_state->in_intervening_code = false;
> +      if (omp_for_parse_state->want_nested_loop)
> +	{
> +	  /* We have already parsed the whole loop body and not found a
> +	     nested loop.  */
> +	  error_at (omp_for_parse_state->for_loc,
> +		    "not enough nested loops");
> +	  omp_for_parse_state->fail = true;
> +	}
> +      if_p = NULL;
> +    }
> +  else
> +    {
> +      /* This is the final-loop-body case in the grammar: we have
> +	 something that is not a FOR and not an open brace.  */
> +      if (moreloops)
> +	{
> +	  /* If we were expecting a nested loop, give an error and mark
> +	     that parsing has failed, and try to recover by parsing the
> +	     body as regular code without further collapsing.  */
> +	  error_at (omp_for_parse_state->for_loc,
> +		    "not enough nested loops");
> +	  omp_for_parse_state->fail = true;
> +	}
> +      in_statement = IN_OMP_FOR;

And/or temporarily clear
parser->omp_for_parse_state here and reset it back afterwards?
Then
  if (parser->omp_for_parse_state
      && (parser->omp_for_parse_state->depth
          < parser->omp_for_parse_state->collapse - 1))
    omp_for_parse_state = parser->omp_for_parse_state;
  else
    omp_for_parse_state = NULL;
etc. wouldn't be really needed, if parser->omp_for_parse_state would
be non-NULL, we'd want to use it without further checks.

> +      body = push_stmt_list ();
> +      if (omp_for_parse_state->inscan)
> +	c_parser_omp_scan_loop_body (parser, false);
> +      else
> +	add_stmt (c_parser_c99_block_statement (parser, if_p));
> +      body = pop_stmt_list (body);
> +    }
> +  in_statement = save_in_statement;
> +  omp_for_parse_state->want_nested_loop = false;
> +  omp_for_parse_state->in_intervening_code = true;
> +
> +  /* Pop and return the implicit scope surrounding this level of loop.
> +     Any iteration variable bound in loop_scope is pulled out and later
> +     will be added to the scope surrounding the entire OMP_FOR.  That
> +     keeps the gimplifier happy later on, and meanwhile we have already
> +     resolved all references to the iteration variable in its true scope.  */
> +  add_stmt (body);
> +  body = c_end_compound_stmt (loc, loop_scope, true);
> +  if (decl && TREE_CODE (body) == BIND_EXPR)

So, this moves just the iteration var if declared in the for loop and nothing else?

> +    {
> +      tree t = BIND_EXPR_VARS (body);
> +      tree prev = NULL_TREE, next = NULL_TREE;
> +      while (t)
> +	{
> +	  next = DECL_CHAIN (t);
> +	  if (t == decl)
> +	    {
> +	      if (prev)
> +		DECL_CHAIN (prev) = next;
> +	      else
> +		{
> +		  BIND_EXPR_VARS (body) = next;
> +		  BLOCK_VARS (BIND_EXPR_BLOCK (body)) = next;
> +		}
> +	      DECL_CHAIN (t) = omp_for_parse_state->bindings;
> +	      omp_for_parse_state->bindings = t;
> +	      break;
> +	    }
> +	  else
> +	    {
> +	      prev = t;
> +	      t = next;
> +	    }
> +	}
> +      if (BIND_EXPR_VARS (body) == NULL_TREE)
> +	body = BIND_EXPR_BODY (body);
> +    }
> +
> +  return body;
> +}
> +
>  /* Parse the restricted form of loop statements allowed by OpenACC and OpenMP.
>     The real trick here is to determine the loop control variable early
>     so that we can push a new decl if necessary to make it private.

> +#pragma omp for ordered(3)
> +  for (i = 0; i < a1; i++)  /* { dg-error "inner loops must be perfectly nested" } */
> +    {
> +      f1 (0, i);
> +      for (j = 0; j < a2; j++)
> +	{
> +	  f1 (1, j);
> +	  for (k = 0; k < a3; k++)
> +	    {
> +	      f1 (2, k);
> +	      f2 (2, k);

Would be good to stick here #pragma omp ordered doacross(source) and sink,
just to make it valid except for the intervening code.

> +	    }
> +	  f2 (1, j);
> +	}
> +      f2 (0, i);
> +    }
> +}
> +
> diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect4.c b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
> new file mode 100644
> index 00000000000..e5feff730a9
> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
> @@ -0,0 +1,35 @@
> +/* { dg-do compile } */
> +
> +/* This test case is expected to fail due to errors.  */
> +
> +static int f1count[3], f2count[3];

Don't declare variables you don't use at all in the test (in multiple
tests).

> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/imperfect5.c
> @@ -0,0 +1,59 @@
> +/* { dg-do compile } */

I think you'd better just copy some existing scan testcase and
just add intervening code to it.

> +
> +/* This test case is expected to fail due to errors.  */
> +
> +static int f1count[3], f2count[3];
> +
> +int f1 (int depth, int iter);
> +int f2 (int depth, int iter);
> +int ijk (int x, int y, int z);
> +void f3 (int sum);
> +
> +/* This function isn't particularly meaningful, but it should compile without
> +   error.  */
> +int s1 (int a1, int a2, int a3)
> +{
> +  int i, j, k;
> +  int r = 0;
> +
> +#pragma omp simd collapse(3) reduction (inscan, +:r)
> +  for (i = 0; i < a1; i++)
> +    {
> +      for (j = 0; j < a2; j++)
> +	{
> +	  for (k = 0; k < a3; k++)
> +	    {
> +	      r = r + ijk (i, j, k);
> +#pragma omp scan exclusive (r)
> +	      f3 (r);
> +	    }
> +	}
> +    }
> +  return r;
> +}
> +
> +/* Adding intervening code should trigger an error.  */
> +int s2 (int a1, int a2, int a3)
> +{
> +  int i, j, k;
> +  int r = 0;
> +
> +#pragma omp simd collapse(3) reduction (inscan, +:r)
> +  for (i = 0; i < a1; i++)  /* { dg-error "inner loops must be perfectly nested" } */
> +    {
> +      f1 (0, i);
> +      for (j = 0; j < a2; j++)
> +	{
> +	  f1 (1, j);
> +	  for (k = 0; k < a3; k++)
> +	    {
> +	      r = r + ijk (i, j, k);
> +#pragma omp scan exclusive (r)
> +	      f3 (r);
> +	    }
> +	  f2 (1, j);
> +	}
> +      f2 (0, i);
> +    }
> +  return r;
> +}

	Jakub


^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: [PATCH 2/3] OpenMP: C++ support for imperfectly-nested loops
  2023-04-28 23:22 ` [PATCH 2/3] OpenMP: C++ " Sandra Loosemore
@ 2023-05-25 10:19   ` Jakub Jelinek
  0 siblings, 0 replies; 7+ messages in thread
From: Jakub Jelinek @ 2023-05-25 10:19 UTC (permalink / raw)
  To: Sandra Loosemore; +Cc: gcc-patches

On Fri, Apr 28, 2023 at 05:22:53PM -0600, Sandra Loosemore wrote:
> OpenMP 5.0 removed the restriction that multiple collapsed loops must
> be perfectly nested, allowing "intervening code" (including nested
> BLOCKs) before or after each nested loop.  In GCC this code is moved
> into the inner loop body by the respective front ends.
> 
> This patch changes the C++ front end to use recursive descent parsing
> on nested loops within an "omp for" construct, rather than an
> iterative approach, in order to preserve proper nesting of compound
> statements.  Preserving cleanups (destructors) for class objects
> declared in intervening code and loop initializers complicates moving
> the former into the body of the loop; this is handled by parsing the
> entire construct before reassembling any of it.

What I wrote about the C patch applies mostly about this patch too,
so I won't review it in detail until the review comments are handled
in both, just would like to note that while C (so far) only supports
#pragma syntax for OpenMP, C++ also supports the attribute syntax
(see e.g. g++.dg/gomp/attrs-*.C testcases).
So, e.g. the no OpenMP constructs in intervening code restriction
applies also to the attribute syntax and needs to be tested for it.
It might work without too many changes because the attribute syntax
is handled by rewriting it essentially into pragma syntax and letting
the parser parse it like that.
Of course, it will matter more for the tile/unroll patch when used together
your patch, when it will need to allow the task generating constructs for
the moreloops cases.

> libgomp/ChangeLog
> 	* testsuite/libgomp.c++/imperfect-class-1.C : New.
> 	* testsuite/libgomp.c++/imperfect-class-2.C : New.
> 	* testsuite/libgomp.c++/imperfect-class-3.C : New.
> 	* testsuite/libgomp.c++/imperfect-destructor.C : New.
> 	* testsuite/libgomp.c++/imperfect-template-1.C : New.
> 	* testsuite/libgomp.c++/imperfect-template-2.C : New.
> 	* testsuite/libgomp.c++/imperfect-template-3.C : New.

Formatting, there shouldn't be space before : in ChangeLog entries.

	Jakub


^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: [PATCH 1/3] OpenMP: C support for imperfectly-nested loops
  2023-05-25 10:00   ` Jakub Jelinek
@ 2023-06-14 22:41     ` Sandra Loosemore
  0 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:41 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: gcc-patches

High-order bit:  I've just committed OG13 version of these patches that is integrated with Frederik's previous loop transformation patches that are already on that branch.  The OG13 version incorporates many of the suggestions from this initial review plus a few bug fixes.  I've also made corresponding fixes to the mainline version but I've still got a lot of unfinished items, mostly related to additional tests for corner cases.

On 5/25/23 04:00, Jakub Jelinek wrote:
> On Fri, Apr 28, 2023 at 05:22:52PM -0600, Sandra Loosemore wrote:
>> OpenMP 5.0 removed the restriction that multiple collapsed loops must
>> be perfectly nested, allowing "intervening code" (including nested
>> BLOCKs) before or after each nested loop.  In GCC this code is moved
>> into the inner loop body by the respective front ends.
>>
>> This patch changes the C front end to use recursive descent parsing
>> on nested loops within an "omp for" construct, rather than an iterative
>> approach, in order to preserve proper nesting of compound statements.
>>
>> gcc/c/ChangeLog
>> 	* c-parser.cc (struct c_parser): Add omp_for_parse_state field.
>> 	(struct omp_for_parse_data): New.
>> 	(c_parser_compound_statement_nostart): Special-case nested
>> 	OMP loops and blocks in intervening code.
>> 	(c_parser_while_statement): Reject in intervening code.
>> 	(c_parser_do_statement): Likewise.
>> 	(c_parser_for_statement): Likewise.
>> 	(c_parser_postfix_expression_after_primary): Reject calls to OMP
>> 	runtime routines in intervening code.
>> 	(c_parser_pragma): Reject OMP pragmas in intervening code.
>> 	(c_parser_omp_loop_nest): New, split from c_parser_omp_for_loop.
>> 	(c_parser_omp_for_loop): Rewrite to use recursive descent and
>> 	generalize handling for intervening code.
>>
>> gcc/ChangeLog
>> 	* omp-api.h: New file.
> 
> Why?  Just add those to omp-general.h.

This is for the Fortran front end, which needs this stuff without everything else omp-general.h sucks in.  I remember that I initially did try to put it in omp-general.h but split it out when I ran into some trouble with that, and I thought it was an abstraction violation in the Fortran front end.  I didn't touch this for now; is it important enough that I should spend more time on it?

>> 	* omp-general.cc (omp_runtime_api_procname): New.
>> 	(omp_runtime_api_call): Moved here from omp-low.cc, and make
>> 	non-static.
>> 	* omp-general.h: Include omp-api.h.
>> 	* omp-low.cc (omp_runtime_api_call): Delete this copy.
>>
>> gcc/testsuite/ChangeLog
>> 	* c-c++-common/goacc/collapse-1.c: Adjust expected error messages.
>> 	* c-c++-common/goacc/tile-2.c: Likewise.
>> 	* c-c++-common/gomp/imperfect1.c: New.
>> 	* c-c++-common/gomp/imperfect2.c: New.
>> 	* c-c++-common/gomp/imperfect3.c: New.
>> 	* c-c++-common/gomp/imperfect4.c: New.
>> 	* c-c++-common/gomp/imperfect5.c: New.
>> 	* gcc.dg/gomp/collapse-1.c: Adjust expected error messages.
>>
>> libgomp/ChangeLog
>> 	* testsuite/libgomp.c-c++-common/imperfect1.c: New.
>> 	* testsuite/libgomp.c-c++-common/imperfect2.c: New.
>> 	* testsuite/libgomp.c-c++-common/imperfect3.c: New.
>> 	* testsuite/libgomp.c-c++-common/imperfect4.c: New.
>> 	* testsuite/libgomp.c-c++-common/imperfect5.c: New.
>> 	* testsuite/libgomp.c-c++-common/imperfect6.c: New.
>> 	* testsuite/libgomp.c-c++-common/offload-imperfect1.c: New.
>> 	* testsuite/libgomp.c-c++-common/offload-imperfect2.c: New.
>> 	* testsuite/libgomp.c-c++-common/offload-imperfect3.c: New.
>> 	* testsuite/libgomp.c-c++-common/offload-imperfect4.c: New.
> 
> If the 3 patches are going to be committed separately (which I think is a
> good idea), then the *c-c++-common* tests are a problem, because the tests
> will then fail after the C FE part is committed before the C++ FE part is
> committed.
> For the new tests there are 2 options, one is commit them in the C patch
> with /* { dg-do run { target c } } */ instead of just
> /* { dg-do run } */ etc. and then in the second patch remove those
> " { target c }" parts, or commit them in the second patch only.
> For the existing tests with adjustments, do the { target c } vs.
> { target c++ } games and tweak in the second patch.

OK, I've split the new c-c++-common tests into a separate commit, and done the other rigamarole to adjust the other test cases incrementally with each part of the series.

> The offload-imperfect* tests should be called target-imperfect* I think,
> for consistency with other tests.

Done.

> In the gcc/testsuite/c-c++-common/gomp/ tests I miss some coverage for
> the boundary cases what is and isn't intervening code.
> Before your changes, we were allowing multiple levels of {}s,
> so
> #pragma omp for ordered(2)
> for (int i = 0; i < 64; i++)
>    {
>      {
>        {
>          for (int j = 0; j < 64; j++)
>            ;
>        }
>      }
>    }
> which is valid in 5.0 (but should be tested in the testsuite), but also
> empty statements, which when reading the 5.1/5.2 spec don't actually seem to
> be valid.
> #pragma omp for ordered(2)
> for (int i = 0; i < 64; i++)
>    {
>      ;
>      ;
>      ;
>      for (int j = 0; j < 64; j++)
>        ;
>      ;
>    }
> because even the empty statement is I think intervening code according to
> the grammar.

Do you have recommendations for what the behavior should be now?  Reject these constructs with an error?  Accept them with a warning?  Or accept them quietly for backward compatibility?

> Another thing I don't really see covered in the testsuite nor in the code
> is if some variable declared in intervening code is then used in the inner
> loop's init/cond/incr expressions.  I mean something like:
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; i++)
>    {
>      int v = (i + 4) * 2;
>      for (int j = v; j < 64; j++)
>        ;
>    }
> That just ICEs with your patch, we should diagnose it as invalid.
> In the canonical loop form requirements the standard requires that the
> expressions are loop invariant with the exceptions of specific cases
> allowed for non-rectangular loops.  So, above I'm sure that is violated.
> Another case would be
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; i++)
>    {
>      int v = (i + 4);
>      for (int j = v; j < 64; j++)
>        ;
>    }
> but here it isn't invariant either, although for (int j = i + 4; j < 64; j++)
> would be valid non-rectangular loop I think it requires the exact syntax.
> Yet another case is
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; i++)
>    {
>      int v = 8;
>      for (int j = v; j < 64; j++)
>        ;
>    }
> This actually is loop invariant (the value) and not really sure what would
> in the standard prevent it from being valid, but it doesn't feel right and
> can't be handled easily, because one should be able to compute the number
> of iterations before the loop where v isn't in scope or there could be a
> different v in scope.
> And/or for C++
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; i++)
>    {
>      const int v = 8; // or even constexpr
>      for (int j = v; j < 64; j++)
>        ;
>    }
> where already during parsing we won't really know we are actually using v
> if it isn't ODR used.  Or unless it is in a template and the const/constexpr
> variable is value or type dependent.
> I think we want to discuss this in omp-lang.

I haven't tackled this group of corner cases yet.  I am not an OpenMP expert and I'd be inclined just to leave FIXMEs for anything that is not entirely clear in the spec, though (and just forget about cases where the spec clearly says something else).

>> @@ -1525,6 +1529,23 @@ struct oacc_routine_data {
>>   /* Used for parsing objc foreach statements.  */
>>   static tree objc_foreach_break_label, objc_foreach_continue_label;
>>   
>> +/* Used for parsing OMP for loops.  See c_parser_omp_for_loop.  */
>> +struct omp_for_parse_data {
>> +  tree declv, condv, incrv, initv;
>> +  tree pre_body;
>> +  tree bindings;
>> +  int collapse;
> 
> I think it is confusing to call this collapse when it isn't collapse
> but ordered ? ordered : collapse.
> Call it count like in c_parser_omp_for_loop?

Done.

>> @@ -6123,6 +6145,15 @@ c_parser_compound_statement_nostart (c_parser *parser)
>>     bool last_label = false;
>>     bool save_valid_for_pragma = valid_location_for_stdc_pragma_p ();
>>     location_t label_loc = UNKNOWN_LOCATION;  /* Quiet warning.  */
>> +  struct omp_for_parse_data *omp_for_parse_state;
>> +
>> +  if (parser->omp_for_parse_state
>> +      && (parser->omp_for_parse_state->depth
>> +	  < parser->omp_for_parse_state->collapse - 1))
>> +    omp_for_parse_state = parser->omp_for_parse_state;
>> +  else
>> +    omp_for_parse_state = NULL;
>> +
>>     if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
>>       {
>>         location_t endloc = c_parser_peek_token (parser)->location;
> 
> So, here we skip over various cases that need to be covered in the testcases
> and decided what to do about.
> The first one is:
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; ++i)
>    {
>      __label__ a, b;
>      goto a; a:;
>      for (int j = 0; j < 64; ++j)
>        ;
>      goto b; b:;
>    }
> This is a GNU extension, do we want to allow it?
> Conceptually it is like variable declarations which can appear in
> intervening code, but we need to make sure it is handled properly
> (the code registers those in the current scope using declare_label, so
> supposedly we want to move those later to the body scope when moving there
> other intervening code.  And probably it should be rejected when intervening
> code is not allowed (+ test for that).
> 
> Next are C2X standard attributes, case XX:/default: (I think these would
> violate the single entry single exit requirements of intervening code),
> label: (that can be fine as long as it is only jumped to from within the
> same intervening code), so again something for the testsuite:
> int k = 0;
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; ++i)
>    {
>      a: if (k) goto a;
>      for (int j = 0; j < 64; ++j)
>        ;
>      b: if (k) goto b;
>    }
> Then __extension__, again something that should be considered whether it
> acts as intervening code, or is even allowed as if it wasn't intervening
> code + testsuite coverage.
> Then pragmas which you handle in c_parser_pragma already (but will need some
> tweaks for tile/unroll from Frederik).
> else is an error, so nothing needs to be done about it.

I haven't done these testcases + fixes yet either, although the integration with Frederik's tile/unroll work is included in the OG13 version of the patches I've just committed.

>> @@ -7138,6 +7223,16 @@ c_parser_while_statement (c_parser *parser, bool ivdep, unsigned short unroll,
>>     gcc_assert (c_parser_next_token_is_keyword (parser, RID_WHILE));
>>     token_indent_info while_tinfo
>>       = get_token_indent_info (c_parser_peek_token (parser));
>> +
>> +  if (parser->omp_for_parse_state
>> +      && (parser->omp_for_parse_state->depth
>> +	  < parser->omp_for_parse_state->collapse - 1))
>> +    {
>> +      error_at (c_parser_peek_token (parser)->location,
>> +		"loop not permitted in intervening code in OMP loop body");
> 
> Please use OpenMP in diagnostics rather than OMP (multiple times).

Done.

> Also, the while and do cases are not covered in the testsuite, they should
> be (there is just test for for in there).
> Would be nice to also test it nested in other compound statements, like
> #pragma omp for collapse(2)
> for (int i = 0; i < 64; ++i)
>    {
>      if (1)
>        {
> 	for (int j = 0; j < 64; ++j)	// { dg-error "..." }
> 	  ;
> 	while (0) ;			// { dg-error "..." }
> 	do { } while (0);		// { dg-error "..." }
>        }
>      for (int k = 0; k < 64; ++k)
>        ;
>    }
> I guess especially the do { ... } while (0); limitation could be quite
> harmful, that is something used heavily in various macros.
> So perhaps for OpenMP 6.0 we should consider there rejecting just
> for statements for C/C++?  And/or also allow for loops if inside of some
> substatement of say if/do/while/switch, those are also clearly
> distinguishable from the main loop.  On the other side, I've never been
> really excited by this imperfectly nested loops mess making it into the
> standard.

Like I said, I'm not an OpenMP expert and I don't want to mess with anything that isn't already clear in the spec, so my inclination would be not wander off proposing/implementing extensions.

>> +      parser->omp_for_parse_state->fail = true;
>> +    }
>> +
>>     c_parser_consume_token (parser);
>>     block = c_begin_compound_stmt (flag_isoc99);
>>     loc = c_parser_peek_token (parser)->location;
>> @@ -11234,6 +11349,14 @@ c_parser_postfix_expression_after_primary (c_parser *parser,
>>   		  && fndecl_built_in_p (expr.value, BUILT_IN_NORMAL)
>>   		  && vec_safe_length (exprlist) == 1)
>>   		warn_for_abs (expr_loc, expr.value, (*exprlist)[0]);
>> +	      if (parser->omp_for_parse_state
>> +		  && parser->omp_for_parse_state->in_intervening_code
>> +		  && omp_runtime_api_call (expr.value))
>> +		{
>> +		  error_at (expr_loc, "Calls to the OpenMP runtime API are "
> 
> s/Calls/calls/, C/C++ FE/middle end diagnostics never start with capital
> letter unless it is part of some shorthand/word always spelled with capital
> letters.

Done.

>> +  if (decl == NULL || decl == error_mark_node || init == error_mark_node)
>> +    omp_for_parse_state->fail = true;
>> +  else
>> +    {
>> +      TREE_VEC_ELT (omp_for_parse_state->declv, omp_for_parse_state->depth)
>> +	= decl;
>> +      TREE_VEC_ELT (omp_for_parse_state->initv, omp_for_parse_state->depth)
>> +	= init;
>> +      TREE_VEC_ELT (omp_for_parse_state->condv, omp_for_parse_state->depth)
>> +	= cond;
>> +      TREE_VEC_ELT (omp_for_parse_state->incrv, omp_for_parse_state->depth)
>> +	= incr;
> 
> This would be more readable using a temporary:
>        int depth = omp_for_parse_state->depth;
>        TREE_VEC_ELT (omp_for_parse_state->declv, depth) = decl;
>        TREE_VEC_ELT (omp_for_parse_state->initv, depth) = init;
>        TREE_VEC_ELT (omp_for_parse_state->condv, depth) = cond;
>        TREE_VEC_ELT (omp_for_parse_state->incrv, depth) = incr;

Done.

> 
>> +    }
>> +
>> +parse_next:
>> +  omp_for_parse_state->want_nested_loop = true;
>> +  moreloops = omp_for_parse_state->depth < omp_for_parse_state->collapse - 1;
> 
> Shouldn't omp_for_parse_state->want_nested_loop be initialized to moreloops
> here?

Done.

> And/or temporarily clear
> parser->omp_for_parse_state here and reset it back afterwards?
> Then
>    if (parser->omp_for_parse_state
>        && (parser->omp_for_parse_state->depth
>            < parser->omp_for_parse_state->collapse - 1))
>      omp_for_parse_state = parser->omp_for_parse_state;
>    else
>      omp_for_parse_state = NULL;
> etc. wouldn't be really needed, if parser->omp_for_parse_state would
> be non-NULL, we'd want to use it without further checks.

Done.

>> +  /* Pop and return the implicit scope surrounding this level of loop.
>> +     Any iteration variable bound in loop_scope is pulled out and later
>> +     will be added to the scope surrounding the entire OMP_FOR.  That
>> +     keeps the gimplifier happy later on, and meanwhile we have already
>> +     resolved all references to the iteration variable in its true scope.  */
>> +  add_stmt (body);
>> +  body = c_end_compound_stmt (loc, loop_scope, true);
>> +  if (decl && TREE_CODE (body) == BIND_EXPR)
> 
> So, this moves just the iteration var if declared in the for loop and nothing else?

Yes.  I've updated the comments to try to explain this better.

>> +#pragma omp for ordered(3)
>> +  for (i = 0; i < a1; i++)  /* { dg-error "inner loops must be perfectly nested" } */
>> +    {
>> +      f1 (0, i);
>> +      for (j = 0; j < a2; j++)
>> +	{
>> +	  f1 (1, j);
>> +	  for (k = 0; k < a3; k++)
>> +	    {
>> +	      f1 (2, k);
>> +	      f2 (2, k);
> 
> Would be good to stick here #pragma omp ordered doacross(source) and sink,
> just to make it valid except for the intervening code.

Skipped this for now.

>> diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect4.c b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
>> new file mode 100644
>> index 00000000000..e5feff730a9
>> --- /dev/null
>> +++ b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
>> @@ -0,0 +1,35 @@
>> +/* { dg-do compile } */
>> +
>> +/* This test case is expected to fail due to errors.  */
>> +
>> +static int f1count[3], f2count[3];
> 
> Don't declare variables you don't use at all in the test (in multiple
> tests).

Fixed.

>> --- /dev/null
>> +++ b/gcc/testsuite/c-c++-common/gomp/imperfect5.c
>> @@ -0,0 +1,59 @@
>> +/* { dg-do compile } */
> 
> I think you'd better just copy some existing scan testcase and
> just add intervening code to it.

I actually tried to do that originally, but I could not find "some existing scan testcase" with more than one loop that I could copy from.  Tobias helped me come up with the testcase I've presently got.

As I said at the top of this mail, the OG13 version of the patches includes the cleanups I indicated are "done", and I've applied those fixes in parallel to the mainline version I'm still working on.  If it would be helpful I could post that as WIP in its current state, or just continue adding the extra testcases, fixing the ICE, etc before reposting.

-Sandra

^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2023-06-14 22:41 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-04-28 23:22 [PATCH 0/3] OpenMP: Support imperfectly-nested loops Sandra Loosemore
2023-04-28 23:22 ` [PATCH 1/3] OpenMP: C support for " Sandra Loosemore
2023-05-25 10:00   ` Jakub Jelinek
2023-06-14 22:41     ` Sandra Loosemore
2023-04-28 23:22 ` [PATCH 2/3] OpenMP: C++ " Sandra Loosemore
2023-05-25 10:19   ` Jakub Jelinek
2023-04-28 23:22 ` [PATCH 3/3] OpenMP: Fortran " Sandra Loosemore

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).