gcc/testsuite/gfortran.dg/implied_do_io_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-O -fdump-tree-original" }
   3 ! PR/35339
   4 ! This test ensures optimization of implied do loops in io statements
   5
   6 program main
   7   implicit none
   8   integer:: i, j, square
   9   integer, parameter:: k = 2, linenum = 14
  10   integer, dimension(2):: a = [(i, i=1,2)]
  11   integer, dimension(2,2):: b = reshape([1, 2, 3, 4], shape(b))
  12   character (len=30), dimension(linenum) :: res
  13   character (len=30) :: line
  14   type tp
  15     integer, dimension(2):: i
  16   end type
  17   type(tp), dimension(2):: t = [tp([1, 2]), tp([1, 2])]
  18   data res / &
  19        ' a   2   2', &
  20        ' b   1   2', &
  21        ' c   1   2', &
  22        ' d   1   2', &
  23        ' e   1   2   1   2', &
  24        ' f   1   2   1   1   2   2', &
  25        ' g   1   2   3   4', &
  26        ' h   1   3   2   4', &
  27        ' i   2', &
  28        ' j   2', &
  29        ' k   1   2   1   2', &
  30        ' l   1', &
  31        ' m   1   1', &
  32        ' n   1   2'/
  33
  34   open(10,file="test.dat")
  35
  36   write (10,1000) 'a', (a(k), i=1,2)
  37   write (10,1000) 'b', (b(i, 1), i=1,2)
  38   write (10,1000) 'c', b(1:2:1, 1)
  39   write (10,1000) 'd', (a(i), i=1,2)
  40   write (10,1000) 'e', ((a(i), i=1,2), j=1,2)
  41   write (10,1000) 'f', (a, b(i, 1), i = 1,2)
  42   write (10,1000) 'g', ((b(i, j), i=1,2),j=1,2)
  43   write (10,1000) 'h', ((b(j, i), i=1,2),j=1,2)
  44   write (10,1000) 'i', (a(i+1), i=1,1)
  45   write (10,1000) 'j', (a(i*2), i=1,1)
  46   write (10,1000) 'k', (a(i), i=1,2), (a(i), i=1,2)
  47   write (10,1000) 'l', (a(i), i=1,1)
  48   write (10,1000) 'm', (1, i=1,2)
  49   write (10,1000) 'n', (t(i)%i(i), i=1,2)
  50   rewind (10)
  51   do i=1,linenum
  52      read (10,'(A)') line
  53      if (line .ne. res(i)) STOP 1
  54   end do
  55   close(10,status="delete")
  56 1000 format (A2,100I4)
  57 end program main
  58
  59 ! { dg-final { scan-tree-dump-times "(?n)^\\s*while \\(1\\)$" 7 "original" } }