1! { dg-do run { target fd_truncate } } 2!TODO: Move these testcases to gfortran testsuite 3! once compilation with pthreads is supported there 4 5! Test BACKSPACE for synchronous and asynchronous I/O 6program main 7 8 integer i, n, nr 9 real x(10), y(10) 10 11 ! PR libfortran/20068 12 open (20, status='scratch', asynchronous="yes") 13 write (20,*, asynchronous="yes" ) 1 14 write (20,*, asynchronous="yes") 2 15 write (20,*, asynchronous="yes") 3 16 rewind (20) 17 i = 41 18 read (20,*, asynchronous="yes") i 19 wait (20) 20 if (i .ne. 1) stop 1 21 write (*,*) ' ' 22 backspace (20) 23 i = 42 24 read (20,*, asynchronous="yes") i 25 close (20) 26 if (i .ne. 1) stop 2 27 28 ! PR libfortran/20125 29 open (20, status='scratch', asynchronous="yes") 30 write (20,*, asynchronous="yes") 7 31 backspace (20) 32 read (20,*, asynchronous="yes") i 33 wait (20) 34 if (i .ne. 7) stop 3 35 close (20) 36 37 open (20, status='scratch', form='unformatted') 38 write (20) 8 39 backspace (20) 40 read (20) i 41 if (i .ne. 8) stop 4 42 close (20) 43 44 ! PR libfortran/20471 45 do n = 1, 10 46 x(n) = sqrt(real(n)) 47 end do 48 open (3, form='unformatted', status='scratch') 49 write (3) (x(n),n=1,10) 50 backspace (3) 51 rewind (3) 52 read (3) (y(n),n=1,10) 53 54 do n = 1, 10 55 if (abs(x(n)-y(n)) > 0.00001) stop 5 56 end do 57 close (3) 58 59 ! PR libfortran/20156 60 open (3, form='unformatted', status='scratch') 61 do i = 1, 5 62 x(1) = i 63 write (3) n, (x(n),n=1,10) 64 end do 65 nr = 0 66 rewind (3) 6720 continue 68 read (3,end=30,err=90) n, (x(n),n=1,10) 69 nr = nr + 1 70 goto 20 7130 continue 72 if (nr .ne. 5) stop 6 73 74 do i = 1, nr+1 75 backspace (3) 76 end do 77 78 do i = 1, nr 79 read(3,end=70,err=90) n, (x(n),n=1,10) 80 if (abs(x(1) - i) .gt. 0.001) stop 7 81 end do 82 close (3) 83 stop 84 8570 continue 86 stop 8 8790 continue 88 stop 9 89 90end program 91