gcc/testsuite/gfortran.dg/ftell_3.f90

   1 ! { dg-do run { target fd_truncate } }
   2 ! PR43605 FTELL intrinsic returns incorrect position
   3 ! Contributed by Janne Blomqvist, Manfred Schwarb
   4 ! and Dominique d'Humieres.
   5 program ftell_3
   6   integer :: i, j
   7   character(1) :: ch
   8   character(len=99) :: buffer
   9   open(10, form='formatted', position='rewind')
  10   write(10, '(a)') '123456'
  11   write(10, '(a)') '789'
  12   write(10, '(a)') 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
  13   write(10, '(a)') 'DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD'
  14   rewind(10)
  15   read(10, '(a)') buffer
  16   call ftell(10, i)
  17 ! Expected: On '\n' systems: 7, on \r\n systems: 8
  18   if(i /= 7 .and. i /= 8) then
  19     STOP 1
  20   end if
  21   read(10,'(a)') buffer
  22   if (trim(buffer) /= "789") then
  23      STOP 1
  24   end if
  25   call ftell(10,j)
  26   close(10)
  27   open(10, access="stream")
  28 ! Expected: On '\n' systems: 11, on \r\n systems: 13
  29   if (i == 7) then
  30     read(10, pos=7) ch
  31     if (ch /= char(10)) STOP 2
  32     if (j /= 11) STOP 3
  33   end if
  34   if (i == 8) then
  35     read(10, pos=7) ch
  36     if (ch /= char(13)) STOP 4
  37     read(10) ch
  38     if (ch /= char(10)) STOP 5
  39     if (j /= 13) STOP 6
  40   end if
  41   close(10, status="delete")
  42 end program ftell_3