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