gcc/testsuite/gfortran.dg/backspace_1.f

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