OpenMP: Fortran support for imperfectly-nested loops

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
	* gfortran.h (struct gfc_namespace): Add omp_structured_block bit.
	* 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.
	(make_structured_block): New.
	(restructure_intervening_code): New.
	(is_outer_iteration_variable): Do not assume loops are perfectly
	nested.
	(check_nested_loop_in_chain): New.
	(check_nested_loop_in_block_state): New.
	(check_nested_loop_in_block_symbol): New.
	(check_nested_loop_in_block): New.
	(expr_uses_intervening_var): New.
	(is_intervening_var): New.
	(expr_is_invariant): Do not assume loops are perfectly nested.
	(resolve_omp_do): Handle imperfectly-nested loops.
	* trans-stmt.cc (gfc_trans_block_construct): Generate
	OMP_STRUCTURED_BLOCK if magic bit is set on block namespace.

gcc/testsuite/ChangeLog
	* gfortran.dg/gomp/collapse1.f90: Adjust expected errors.
	* gfortran.dg/gomp/collapse2.f90: Likewise.
	* gfortran.dg/gomp/imperfect-gotos.f90: New.
	* gfortran.dg/gomp/imperfect-invalid-scope.f90: New.
	* 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/target-imperfect1.f90: New.
	* testsuite/libgomp.fortran/target-imperfect2.f90: New.
	* testsuite/libgomp.fortran/target-imperfect3.f90: New.
	* testsuite/libgomp.fortran/target-imperfect4.f90: New.

9 files changed, 966 insertions, 0 deletions

diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
new file mode 100644
index 0000000..664d27f
--- /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 0000000..8c483c2
--- /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 0000000..e42cb08
--- /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 0000000..da09461
--- /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 0000000..1679c8c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
@@ -0,0 +1,121 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but includes blocks that are themselves wholly
+! intervening code and not containers for nested loops.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp do collapse(3)
+  do i = 1, a1
+    block
+      call f1 (1, i)
+    end block
+    block
+      block
+        call g1 (1, i)
+      end block
+      do j = 1, a2
+        block
+          call f1 (2, j)
+        end block
+        block
+          block
+            call g1 (2, j)
+          end block
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          block
+            call g2 (2, j)
+          end block
+        end block
+        block
+          call f2 (2, j)
+        end block
+      end do
+      block
+        call g2 (1, i)
+      end block
+    end block
+    block
+      call f2 (1, i)
+    end block
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
new file mode 100644
index 0000000..608eee7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3)
+  !$omp declare target enter (f1count, f2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+  do i = 1, a1
+    call f1 (1, i)
+    do j = 1, a2
+      call f1 (2, j)
+      do k = 1, a3
+        call f1 (3, k)
+        call f2 (3, k)
+      end do
+      call f2 (2, j)
+    end do
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
new file mode 100644
index 0000000..982661c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      call g1 (1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+          call g1 (2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
new file mode 100644
index 0000000..6f4f92d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
@@ -0,0 +1,116 @@
+! { dg-do run }
+
+! Like imperfect3.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    call f1 (1, i)
+    block
+      integer :: local1
+      local1 = 1
+      call g1 (local1, i)
+      do j = 1, a2
+        call f1 (2, j)
+        block
+	  integer :: local2
+	  local2 = 2
+          call g1 (local2, j)
+          do k = 1, a3
+            call f1 (3, k)
+            block
+	      integer :: local3
+	      local3 = 3
+              call g1 (local3, k)
+              call g2 (local3, k)
+            end block
+            call f2 (3, k)
+          end do
+          call g2 (local2, j)
+        end block
+        call f2 (2, j)
+      end do
+      call g2 (local1, i)
+    end block
+    call f2 (1, i)
+  end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
new file mode 100644
index 0000000..59ec0e9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
@@ -0,0 +1,126 @@
+! { dg-do run }
+
+! Like imperfect4.f90, but enables offloading.
+
+program foo
+  integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+  !$omp declare target enter (f1count, f2count)
+  !$omp declare target enter (g1count, g2count)
+
+  f1count(1) = 0
+  f1count(2) = 0
+  f1count(3) = 0
+  f2count(1) = 0
+  f2count(2) = 0
+  f2count(3) = 0
+
+  g1count(1) = 0
+  g1count(2) = 0
+  g1count(3) = 0
+  g2count(1) = 0
+  g2count(2) = 0
+  g2count(3) = 0
+
+  call s1 (3, 4, 5)
+
+  ! All intervening code at the same depth must be executed the same
+  ! number of times.
+  if (f1count(1) /= f2count(1)) error stop 101
+  if (f1count(2) /= f2count(2)) error stop 102
+  if (f1count(3) /= f2count(3)) error stop 103
+  if (g1count(1) /= f1count(1)) error stop 104
+  if (g2count(1) /= f1count(1)) error stop 105
+  if (g1count(2) /= f1count(2)) error stop 106
+  if (g2count(2) /= f1count(2)) error stop 107
+  if (g1count(3) /= f1count(3)) error stop 108
+  if (g2count(3) /= f1count(3)) error stop 109
+
+  ! Intervening code must be executed at least as many times as the loop
+  ! that encloses it.
+  if (f1count(1) < 3) error stop 111
+  if (f1count(2) < 3 * 4) error stop 112
+
+  ! Intervening code must not be executed more times than the number
+  ! of logical iterations.
+  if (f1count(1) > 3 * 4 * 5) error stop 121
+  if (f1count(2) > 3 * 4 * 5) error stop 122
+
+  ! Check that the innermost loop body is executed exactly the number
+  ! of logical iterations expected.
+  if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+  integer :: depth, iter
+  !$omp atomic
+  g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+  integer :: a1, a2, a3
+  integer :: i, j, k
+
+  !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+  do i = 1, a1
+    block
+      call f1 (1, i)
+    end block
+    block
+      block
+        call g1 (1, i)
+      end block
+      do j = 1, a2
+        block
+          call f1 (2, j)
+        end block
+        block
+          block
+            call g1 (2, j)
+          end block
+          do k = 1, a3
+            call f1 (3, k)
+            block
+              call g1 (3, k)
+              call g2 (3, k)
+            end block
+            call f2 (3, k)
+          end do
+          block
+            call g2 (2, j)
+          end block
+        end block
+        block
+          call f2 (2, j)
+        end block
+      end do
+      block
+        call g2 (1, i)
+      end block
+    end block
+    block
+      call f2 (1, i)
+    end block
+  end do
+
+end subroutine
+
+end program