re PR fortran/80988 (171_swim fails)

2017-06-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/80988
	* frontend-passes.c (traverse_io_block):  Also
	check for variables occurring as indices multiple
	time in a single implied DO loop.

2017-06-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/80988
	* gfortran.dg/implied_do_io_3.f90:  New test.

From-SVN: r249092

gcc/fortran/ChangeLog

+2017-06-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/80988
+	* frontend-passes.c (traverse_io_block):  Also
+	check for variables occurring as indices multiple
+	time in a single implied DO loop.
+
 2017-06-05  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/70601

gcc/fortran/frontend-passes.c

@@ -1164,7 +1164,16 @@ traverse_io_block (gfc_code *code, bool *has_reached, gfc_code *prev)
 	  /*  Check for (a(k), i=1,4) or ((a(j, i), i=1,4), j=1,4).  */
 	  if (!stack_top || !stack_top->iter
 	      || stack_top->iter->var->symtree != start->symtree)
-	    iters[i] = NULL;
+	    {
+	      /* Check for (a(i,i), i=1,3).  */
+	      int j;
+	      
+	      for (j=0; j<i; j++)
+		if (iters[j] && iters[j]->var->symtree == start->symtree)
+		  return false;
+
+	      iters[i] = NULL;
+	    }
 	  else
 	    {
 	      iters[i] = stack_top->iter;

gcc/testsuite/ChangeLog

+2017-06-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/80988
+	* gfortran.dg/implied_do_io_3.f90:  New test.
+
 2017-06-10  Tom de Vries  <tom@codesourcery.com>
 
 	* lib/target-supports.exp (check_effective_target_signal): New proc.

gcc/testsuite/gfortran.dg/implied_do_io_3.f90

+! { dg-do run }
+! { dg-options "-ffrontend-optimize" }
+! PR 80988 - implied do loops with diagonal elements
+! were not written correctly
+program main
+  implicit none
+  integer :: i,j,k
+  integer, dimension(3,3) :: a
+  integer, dimension(3,3,3) :: b
+  character(len=40) :: line
+  a = reshape([(((i*10+j),i=1,3),j=1,3)], shape(a))
+  i = 2147483548
+  write (unit=line,fmt='(10I3)') (a(i,i),i=1,3)
+  if (line /= ' 11 22 33') call abort
+  write (unit=line,fmt='(10I3)') (a(i+1,i+1),i=1,2)
+  if (line /= ' 22 33') call abort
+  do k=1,3
+     do j=1,3
+        do i=1,3
+           b(i,j,k) = i*100 + j*10 + k
+        end do
+     end do
+  end do
+  i = -2147483548
+  write (unit=line,fmt='(10I4)') ((b(i,j,i),i=1,3),j=1,3)
+  if (line /= ' 111 212 313 121 222 323 131 232 333') call abort
+end program main