gcc/testsuite/gfortran.dg/record_marker_2.f

   1 ! { dg-do run }
   2 ! { dg-options "-frecord-marker=4" }
   3 ! This file is all about BACKSPACE
   4 ! Adapted from gfortran.dg/backspace.f
   5
   6       integer i, n, nr
   7       real x(10), y(10)
   8
   9 ! PR libfortran/20068
  10       open (20, status='scratch')
  11       write (20,*) 1
  12       write (20,*) 2
  13       write (20,*) 3
  14       rewind (20)
  15       read (20,*) i
  16       if (i .ne. 1) call abort
  17       backspace (20)
  18       read (20,*) i
  19       if (i .ne. 1) call abort
  20       close (20)
  21
  22 ! PR libfortran/20125
  23       open (20, status='scratch')
  24       write (20,*) 7
  25       backspace (20)
  26       read (20,*) i
  27       if (i .ne. 7) call abort
  28       close (20)
  29
  30       open (20, status='scratch', form='unformatted')
  31       write (20) 8
  32       backspace (20)
  33       read (20) i
  34       if (i .ne. 8) call abort
  35       close (20)
  36
  37 ! PR libfortran/20471
  38       do n = 1, 10
  39         x(n) = sqrt(real(n))
  40       end do
  41       open (3, form='unformatted', status='scratch')
  42       write (3) (x(n),n=1,10)
  43       backspace (3)
  44       rewind (3)
  45       read (3) (y(n),n=1,10)
  46
  47       do n = 1, 10
  48         if (abs(x(n)-y(n)) > 0.00001) call abort
  49       end do
  50       close (3)
  51
  52 ! PR libfortran/20156
  53       open (3, form='unformatted', status='scratch')
  54       do i = 1, 5
  55         x(1) = i
  56         write (3) n, (x(n),n=1,10)
  57       end do
  58       nr = 0
  59       rewind (3)
  60   20  continue
  61       read (3,end=30,err=90) n, (x(n),n=1,10)
  62       nr = nr + 1
  63       goto 20
  64   30  continue
  65       if (nr .ne. 5) call abort
  66
  67       do i = 1, nr+1
  68         backspace (3)
  69       end do
  70
  71       do i = 1, nr
  72         read(3,end=70,err=90) n, (x(n),n=1,10)
  73         if (abs(x(1) - i) .gt. 0.001) call abort
  74       end do
  75       close (3)
  76       stop
  77
  78   70  continue
  79       call abort
  80   90  continue
  81       call abort
  82
  83       end