mirror of
https://github.com/autc04/Retro68.git
synced 2024-12-13 18:34:45 +00:00
91 lines
1.7 KiB
Fortran
91 lines
1.7 KiB
Fortran
|
! { dg-do run { target fd_truncate } }
|
||
|
|
!TODO: Move these testcases to gfortran testsuite
|
||
|
|
! once compilation with pthreads is supported there
|
||
|
|
|
||
|
|
! Test BACKSPACE for synchronous and asynchronous I/O
|
||
|
|
program main
|
||
|
|
|
||
|
|
integer i, n, nr
|
||
|
|
real x(10), y(10)
|
||
|
|
|
||
|
|
! PR libfortran/20068
|
||
|
|
open (20, status='scratch', asynchronous="yes")
|
||
|
|
write (20,*, asynchronous="yes" ) 1
|
||
|
|
write (20,*, asynchronous="yes") 2
|
||
|
|
write (20,*, asynchronous="yes") 3
|
||
|
|
rewind (20)
|
||
|
|
i = 41
|
||
|
|
read (20,*, asynchronous="yes") i
|
||
|
|
wait (20)
|
||
|
|
if (i .ne. 1) STOP 1
|
||
|
|
write (*,*) ' '
|
||
|
|
backspace (20)
|
||
|
|
i = 42
|
||
|
|
read (20,*, asynchronous="yes") i
|
||
|
|
close (20)
|
||
|
|
if (i .ne. 1) STOP 2
|
||
|
|
|
||
|
|
! PR libfortran/20125
|
||
|
|
open (20, status='scratch', asynchronous="yes")
|
||
|
|
write (20,*, asynchronous="yes") 7
|
||
|
|
backspace (20)
|
||
|
|
read (20,*, asynchronous="yes") i
|
||
|
|
wait (20)
|
||
|
|
if (i .ne. 7) STOP 3
|
||
|
|
close (20)
|
||
|
|
|
||
|
|
open (20, status='scratch', form='unformatted')
|
||
|
|
write (20) 8
|
||
|
|
backspace (20)
|
||
|
|
read (20) i
|
||
|
|
if (i .ne. 8) STOP 4
|
||
|
|
close (20)
|
||
|
|
|
||
|
|
! PR libfortran/20471
|
||
|
|
do n = 1, 10
|
||
|
|
x(n) = sqrt(real(n))
|
||
|
|
end do
|
||
|
|
open (3, form='unformatted', status='scratch')
|
||
|
|
write (3) (x(n),n=1,10)
|
||
|
|
backspace (3)
|
||
|
|
rewind (3)
|
||
|
|
read (3) (y(n),n=1,10)
|
||
|
|
|
||
|
|
do n = 1, 10
|
||
|
|
if (abs(x(n)-y(n)) > 0.00001) STOP 5
|
||
|
|
end do
|
||
|
|
close (3)
|
||
|
|
|
||
|
|
! PR libfortran/20156
|
||
|
|
open (3, form='unformatted', status='scratch')
|
||
|
|
do i = 1, 5
|
||
|
|
x(1) = i
|
||
|
|
write (3) n, (x(n),n=1,10)
|
||
|
|
end do
|
||
|
|
nr = 0
|
||
|
|
rewind (3)
|
||
|
|
20 continue
|
||
|
|
read (3,end=30,err=90) n, (x(n),n=1,10)
|
||
|
|
nr = nr + 1
|
||
|
|
goto 20
|
||
|
|
30 continue
|
||
|
|
if (nr .ne. 5) STOP 6
|
||
|
|
|
||
|
|
do i = 1, nr+1
|
||
|
|
backspace (3)
|
||
|
|
end do
|
||
|
|
|
||
|
|
do i = 1, nr
|
||
|
|
read(3,end=70,err=90) n, (x(n),n=1,10)
|
||
|
|
if (abs(x(1) - i) .gt. 0.001) STOP 7
|
||
|
|
end do
|
||
|
|
close (3)
|
||
|
|
stop
|
||
|
|
|
||
|
|
70 continue
|
||
|
|
STOP 8
|
||
|
|
90 continue
|
||
|
|
STOP 9
|
||
|
|
|
||
|
|
end program
|