gcc/testsuite/gfortran.dg/write_rewind_2.f

   1 ! { dg-do run }
   2 ! PR 26499  Test write with rewind sequences to make sure buffering and
   3 ! end-of-file conditions are handled correctly.  Derived from test case by Dale
   4 ! Ranta.  Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
   5       program test
   6       dimension idata(1011)
   7       open(unit=11,form='unformatted')
   8         idata(1)   = -705
   9         idata(  1011)   = -706
  10        write(11)idata
  11         idata(1)   = -706
  12         idata(  1011)   = -707
  13        write(11)idata
  14         idata(1)   = -707
  15         idata(  1011)   = -708
  16        write(11)idata
  17        read(11,end=        1000 )idata
  18        call abort()
  19  1000  continue
  20        rewind 11
  21        read(11,end=        1001 )idata
  22         if(idata(1).ne. -705.or.idata(  1011).ne. -706)call abort()
  23  1001  continue
  24        close(11,status='keep')
  25       open(unit=11,form='unformatted')
  26       rewind 11
  27       read(11)idata
  28       if(idata(1).ne.-705)then
  29       call abort()
  30       endif
  31       read(11)idata
  32       if(idata(1).ne.-706)then
  33       call abort()
  34       endif
  35       read(11)idata
  36       if(idata(1).ne.-707)then
  37       call abort()
  38       endif
  39       close(11,status='delete')
  40       stop
  41       end
  42
  43