diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/frontend-passes.c | 11 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/implied_do_io_3.f90 | 27 |
4 files changed, 49 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 33b2ac2..ec28113 100644 --- 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 8fa1de1..11c7503 100644 --- 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 190054e..531c787 100644 --- 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 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 |