old-autovect-branch/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90

   1 ! pr 15472
   2 ! sequential access files
   3 !
   4 !  this test verifies the most basic sequential unformatted I/O
   5 !      write 3 records of various sizes
   6 !      then read them back
   7 !      and compare with what was written
   8 !
   9        implicit none
  10        integer size
  11        parameter(size=100)
  12        logical debug
  13        data debug /.FALSE./
  14 ! set debug to true for help in debugging failures.
  15        integer m(2)
  16        integer n
  17        real*4 r(size)
  18        integer i
  19        m(1) = Z'11111111'
  20        m(2) = Z'22222222'
  21        n    = Z'33333333'
  22        do i = 1,size
  23          r(i) = i
  24        end do
  25        write(9)m  ! an array of 2
  26        write(9)n  ! an integer
  27        write(9)r  ! an array of reals
  28 ! zero all the results so we can compare after they are read back
  29        do i = 1,size
  30           r(i) = 0
  31        end do
  32        m(1) = 0
  33        m(2) = 0
  34        n = 0
  35
  36        rewind(9)
  37        read(9)m
  38        read(9)n
  39        read(9)r
  40 !
  41 ! check results
  42        if (m(1).ne.Z'11111111') then
  43          if (debug) then
  44             print '(A,Z8)','m(1) incorrect.  m(1) = ',m(1)
  45          else
  46             call abort
  47          endif
  48        endif
  49
  50        if (m(2).ne.Z'22222222') then
  51          if (debug) then
  52             print '(A,Z8)','m(2) incorrect.  m(2) = ',m(2)
  53          else
  54             call abort
  55          endif
  56        endif
  57
  58        if (n.ne.Z'33333333') then
  59          if (debug) then
  60             print '(A,Z8)','n incorrect.  n = ',n
  61          else
  62             call abort
  63          endif
  64        endif
  65
  66        do i = 1,size
  67           if (int(r(i)).ne.i) then
  68             if (debug) then
  69               print*,'element ',i,' was ',r(i),' should be ',i
  70             else
  71               call abort
  72             endif
  73           endif
  74        end do
  75 ! use hexdump to look at the file "fort.9"
  76        if (debug) then
  77          close(9)
  78        else
  79          close(9,status='DELETE')
  80        endif
  81        end