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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 33b2ac2ae23f820bbfd16b083205de66abe70300..ec28113820ec396dc7f1b29744b61a6f919fa499 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 8fa1de12acc5b5076a5e3aebaa64fbeb51e649b5..11c750352104ab468600c96536953508f8e7453e 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 190054e53a95e323cfcdcac052228b8a74901fc6..531c787996157a41426a530c68ee29de4d73c71b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/implied_do_io_3.f90 b/gcc/testsuite/gfortran.dg/implied_do_io_3.f90
new file mode 100644 (file)
index 0000000..6ac89ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implied_do_io_3.f90
@@ -0,0 +1,27 @@
+! { 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