1! { dg-do run }
2!TODO: Move these testcases to gfortran testsuite
3! once compilation with pthreads is supported there
4! Check basic functionality of async I/O
5program main
6  implicit none
7  integer:: i=1, j=2, k, l
8  real :: a, b, c, d
9  character(3), parameter:: yes="yes"
10  character(4) :: str
11  complex :: cc, dd
12  integer, dimension(4):: is = [0, 1, 2, 3]
13  integer, dimension(4):: res
14  character(10) :: inq
15
16  open (10, file='a.dat', asynchronous=yes)
17  cc = (1.5, 0.5)
18  inquire (10,asynchronous=inq)
19  if (inq /= "YES") stop 1
20  write (10,*,asynchronous=yes) 4, 3
21  write (10,*,asynchronous=yes) 2, 1
22  write (10,*,asynchronous=yes) 1.0, 3.0
23  write (10,'(A)', asynchronous=yes) 'asdf'
24  write (10,*, asynchronous=yes) cc
25  close (10)
26  open (20, file='a.dat', asynchronous=yes)
27  read (20, *, asynchronous=yes) i, j
28  read (20, *, asynchronous=yes) k, l
29  read (20, *, asynchronous=yes) a, b
30  read (20,'(A4)',asynchronous=yes) str
31  read (20,*, asynchronous=yes) dd
32  wait (20)
33  if (i /= 4 .or. j /= 3) stop 2
34  if (k /= 2 .or. l /= 1) stop 3
35  if (a /= 1.0 .or. b /= 3.0) stop 4
36  if (str /= 'asdf') stop 5
37  if (cc /= dd) stop 6
38  close (20,status="delete")
39
40  open(10, file='c.dat', asynchronous=yes)
41  write(10, *, asynchronous=yes) is
42  close(10)
43  open(20, file='c.dat', asynchronous=yes)
44  read(20, *, asynchronous=yes) res
45  wait (20)
46  if (any(res /= is)) stop 7
47  close (20,status="delete")
48end program
49