gcc/testsuite/gfortran.dg/streamio_15.f90

   1 ! { dg-do run { target fd_truncate } }
   2 ! PR35132 Formatted stream I/O write should truncate.
   3 ! Test case adapted from PR by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
   4 program main
   5   implicit none
   6   character(len=6) :: c
   7   integer :: i, newline_length
   8
   9   open(20,status="scratch",access="stream",form="formatted")
  10   write(20,"()")
  11   inquire(20,pos=newline_length)
  12   newline_length = newline_length - 1
  13   if (newline_length < 1 .or. newline_length > 2) call abort
  14   close(20)
  15
  16   open(20,file="foo.txt",form="formatted",access="stream")
  17   write(20,'(A)') '123456'
  18   write(20,'(A)') 'abcdef'
  19   write(20,'(A)') 'qwerty'
  20   rewind 20
  21   ! Skip over the first line
  22   read(20,'(A)') c
  23   if (c.ne.'123456') call abort
  24   ! Save the position
  25   inquire(20,pos=i)
  26   if (i.ne.7+newline_length) call abort
  27   ! Read in the complete line...
  28   read(20,'(A)') c
  29   if (c.ne.'abcdef') call abort
  30   ! Write out the first four characters
  31   write(20,'(A)',pos=i,advance="no") 'ASDF'
  32   ! Fill up the rest of the line.  Here, we know the length.  If we
  33   ! don't, things will be a bit more complicated.
  34   write(20,'(A)') c(5:6)
  35   ! Copy the file to standard output
  36   rewind 20
  37   c = ""
  38   read(20,'(A)') c
  39   if (c.ne.'123456') call abort
  40   read(20,'(A)') c
  41   if (c.ne.'ASDFef') call abort
  42   read(20,'(A)', iostat=i) c
  43   if (i /= -1) call abort
  44   close (20, status="delete")
  45 end program main