gcc/testsuite/gfortran.dg/direct_io_12.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/43551
   4 !
   5 ! Writes a 672000 byte file with buffering. The writing failed because
   6 ! of a missing lseek.
   7
   8 implicit none
   9 integer, parameter :: size = 2800 ! << needs to be large enough
  10 real(8) :: vec1(size,30), dummy(size)
  11 integer i
  12
  13 CALL RANDOM_NUMBER(vec1)
  14
  15 open(99, file='test.dat', form='unformatted', access='direct', recl=size*8)
  16 do i = 1, 10
  17   write(99,rec=i) vec1(:,i)
  18   write(99,rec=i+10) vec1(:,i+10)
  19   write(99,rec=i+20) vec1(:,i+20) ! << rec = 30 was written to rec = 21
  20 end do
  21
  22 do i = 1, 10
  23   read(99,rec=i) dummy
  24   if (any (dummy /= vec1(:,i))) call abort()
  25   read(99,rec=i+10) dummy
  26   if (any (dummy /= vec1(:,i+10))) call abort()
  27   read(99,rec=i+20) dummy
  28   if (any (dummy /= vec1(:,i+20))) call abort() ! << aborted here for rec = 21
  29 end do
  30
  31 close(99, status='delete')
  32 end
  33