From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 4 Aug 2020 16:17:04 +0000 (+0200)
Subject: Fortran/OpenMP: Fix detecting not perfectly nested loops
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=6b7a692fd96094446167e42b8298dc4680452528;p=thirdparty%2Fgcc.git

Fortran/OpenMP: Fix detecting not perfectly nested loops

gcc/fortran/ChangeLog:

	* openmp.c (resolve_omp_do): Detect not perfectly
	nested loop with innermost collapse.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/collapse1.f90: Add dg-error.
	* gfortran.dg/gomp/collapse2.f90: New test.
---

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index ec116206a5c7..f402febc2113 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -6202,8 +6202,6 @@ resolve_omp_do (gfc_code *code)
 	      do_code2 = do_code2->block->next;
 	    }
 	}
-      if (i == collapse)
-	break;
       for (c = do_code->next; c; c = c->next)
 	if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
 	  {
@@ -6211,7 +6209,7 @@ resolve_omp_do (gfc_code *code)
 		       name, &c->loc);
 	    break;
 	  }
-      if (c)
+      if (i == collapse || c)
 	break;
       do_code = do_code->block;
       if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index f16a780ad994..1a06eaba8237 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -31,7 +31,7 @@ subroutine collapse1
     do i = 1, 3
       do j = 4, 6
       end do
-      k = 4
+      k = 4  ! { dg-error "loops not perfectly nested" }
     end do
   !$omp parallel do collapse(2)
     do i = 1, 3
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
new file mode 100644
index 000000000000..1ab934e3d0dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
@@ -0,0 +1,32 @@
+program p
+   integer :: i, j, k
+   real :: x
+   !$omp parallel do collapse(3)
+   do i = 1, 8
+      do j = 1, 8
+        do k = 1, 8
+        end do
+        x = 5  ! { dg-error "loops not perfectly nested" }
+      end do
+   end do
+   !$omp parallel do ordered(3)
+   do i = 1, 8
+      do j = 1, 8
+        do k = 1, 8
+        end do
+      end do
+      x = 5  ! { dg-error "loops not perfectly nested" }
+   end do
+   !$omp parallel do collapse(2)  ! { dg-error "not enough DO loops for collapsed" }
+   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" }
+   do i = 1, 8
+      x = 5
+      do j = 1, 8
+      end do
+   end do
+end