Patchwork [committed] Fix exit and cycle handling in collapsed !$omp do (PR fortran/44847)

login
register
mail settings
Submitter Jakub Jelinek
Date July 8, 2010, 5:40 p.m.
Message ID <20100708174000.GN20208@tyan-ft48-01.lab.bos.redhat.com>
Download mbox | patch
Permalink /patch/58267/
State New
Headers show

Comments

Jakub Jelinek - July 8, 2010, 5:40 p.m.
Hi!

The following patch fixes match_exit_cycle diagnostics for
collapsed omp do loops.

Bootstrapped/regtested on x86_64-linux and i686-linux, applied to
trunk/4.5/4.4.

2010-07-08  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/44847
	* match.c (match_exit_cycle): Error on EXIT also from collapsed
	!$omp do loops.  Error on CYCLE to non-innermost collapsed
	!$omp do loops.

	* gfortran.dg/gomp/pr44847.f90: New test.


	Jakub

Patch

--- gcc/fortran/match.c.jj	2010-07-08 12:33:29.000000000 +0200
+++ gcc/fortran/match.c	2010-07-08 12:41:06.000000000 +0200
@@ -2000,6 +2000,7 @@  match_exit_cycle (gfc_statement st, gfc_
   gfc_state_data *p, *o;
   gfc_symbol *sym;
   match m;
+  int cnt;
 
   if (gfc_match_eos () == MATCH_YES)
     sym = NULL;
@@ -2022,7 +2023,7 @@  match_exit_cycle (gfc_statement st, gfc_
 	}
     }
 
-  /* Find the loop mentioned specified by the label (or lack of a label).  */
+  /* Find the loop specified by the label (or lack of a label).  */
   for (o = NULL, p = gfc_state_stack; p; p = p->previous)
     if (p->state == COMP_DO && (sym == NULL || sym == p->sym))
       break;
@@ -2053,17 +2054,34 @@  match_exit_cycle (gfc_statement st, gfc_
 		 gfc_ascii_statement (st));
       return MATCH_ERROR;
     }
-  else if (st == ST_EXIT
-	   && p->previous != NULL
-	   && p->previous->state == COMP_OMP_STRUCTURED_BLOCK
-	   && (p->previous->head->op == EXEC_OMP_DO
-	       || p->previous->head->op == EXEC_OMP_PARALLEL_DO))
-    {
-      gcc_assert (p->previous->head->next != NULL);
-      gcc_assert (p->previous->head->next->op == EXEC_DO
-		  || p->previous->head->next->op == EXEC_DO_WHILE);
-      gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
-      return MATCH_ERROR;
+
+  for (o = p, cnt = 0; o->state == COMP_DO && o->previous != NULL; cnt++)
+    o = o->previous;
+  if (cnt > 0
+      && o != NULL
+      && o->state == COMP_OMP_STRUCTURED_BLOCK
+      && (o->head->op == EXEC_OMP_DO
+	  || o->head->op == EXEC_OMP_PARALLEL_DO))
+    {
+      int collapse = 1;
+      gcc_assert (o->head->next != NULL
+		  && (o->head->next->op == EXEC_DO
+		      || o->head->next->op == EXEC_DO_WHILE)
+		  && o->previous != NULL
+		  && o->previous->tail->op == o->head->op);
+      if (o->previous->tail->ext.omp_clauses != NULL
+	  && o->previous->tail->ext.omp_clauses->collapse > 1)
+	collapse = o->previous->tail->ext.omp_clauses->collapse;
+      if (st == ST_EXIT && cnt <= collapse)
+	{
+	  gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
+	  return MATCH_ERROR;
+	}
+      if (st == ST_CYCLE && cnt < collapse)
+	{
+	  gfc_error ("CYCLE statement at %C to non-innermost collapsed !$OMP DO loop");
+	  return MATCH_ERROR;
+	}
     }
 
   /* Save the first statement in the loop - needed by the backend.  */
--- gcc/testsuite/gfortran.dg/gomp/pr44847.f90.jj	2010-07-08 12:36:38.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/pr44847.f90	2010-07-08 12:38:06.000000000 +0200
@@ -0,0 +1,86 @@ 
+! PR fortran/44847
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine pr44847_1
+  integer :: i, j
+!$omp parallel do collapse(2)
+l:do i = 1, 2
+    do j = 1, 2
+      cycle l		! { dg-error "CYCLE statement" }
+    end do
+  end do l
+end subroutine
+subroutine pr44847_2
+  integer :: i, j, k
+!$omp parallel do collapse(3)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        cycle l		! { dg-error "CYCLE statement" }
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_3
+  integer :: i, j
+!$omp parallel do
+l:do i = 1, 2
+    do j = 1, 2
+      cycle l
+    end do
+  end do l
+end subroutine
+subroutine pr44847_4
+  integer :: i, j, k
+!$omp parallel do collapse(2)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        cycle l
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_5
+  integer :: i, j
+!$omp parallel do collapse(2)
+l:do i = 1, 2
+    do j = 1, 2
+      exit l		! { dg-error "EXIT statement" }
+    end do
+  end do l
+end subroutine
+subroutine pr44847_6
+  integer :: i, j, k
+!$omp parallel do collapse(3)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        exit l		! { dg-error "EXIT statement" }
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_7
+  integer :: i, j, k
+!$omp parallel do collapse(2)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        exit l		! { dg-error "EXIT statement" }
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_8
+  integer :: i, j, k
+!$omp parallel do
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        exit l
+      end do
+    end do l
+  end do
+end subroutine