re PR fortran/25829 ([F03] Asynchronous IO support)

2018-08-21  Nicolas Koenig  <koenigni@gcc.gnu.org>
	Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* gfortran.texi: Add description of asynchronous I/O.
	* trans-decl.c (gfc_finish_var_decl): Treat asynchronous variables
	as volatile.
	* trans-io.c (gfc_build_io_library_fndecls): Rename st_wait to
	st_wait_async and change argument spec from ".X" to ".w".
	(gfc_trans_wait): Pass ID argument via reference.

2018-08-21  Nicolas Koenig  <koenigni@gcc.gnu.org>
	Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* gfortran.dg/f2003_inquire_1.f03: Add write statement.
	* gfortran.dg/f2003_io_1.f03: Add wait statement.

2018-08-21  Nicolas Koenig  <koenigni@gcc.gnu.org>
	Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* Makefile.am: Add async.c to gfor_io_src.
	Add async.h to gfor_io_headers.
	* Makefile.in: Regenerated.
	* gfortran.map: Add _gfortran_st_wait_async.
	* io/async.c: New file.
	* io/async.h: New file.
	* io/close.c: Include async.h.
	(st_close): Call async_wait for an asynchronous unit.
	* io/file_pos.c (st_backspace): Likewise.
	(st_endfile): Likewise.
	(st_rewind): Likewise.
	(st_flush): Likewise.
	* io/inquire.c: Add handling for asynchronous PENDING
	and ID arguments.
	* io/io.h (st_parameter_dt): Add async bit.
	(st_parameter_wait): Correct.
	(gfc_unit): Add au pointer.
	(st_wait_async): Add prototype.
	(transfer_array_inner): Likewise.
	(st_write_done_worker): Likewise.
	* io/open.c: Include async.h.
	(new_unit): Initialize asynchronous unit.
	* io/transfer.c (async_opt): New struct.
	(wrap_scalar_transfer): New function.
	(transfer_integer): Call wrap_scalar_transfer to do the work.
	(transfer_real): Likewise.
	(transfer_real_write): Likewise.
	(transfer_character): Likewise.
	(transfer_character_wide): Likewise.
	(transfer_complex): Likewise.
	(transfer_array_inner): New function.
	(transfer_array): Call transfer_array_inner.
	(transfer_derived): Call wrap_scalar_transfer.
	(data_transfer_init): Check for asynchronous I/O.
	Perform a wait operation on any pending asynchronous I/O
	if the data transfer is synchronous. Copy PDT and enqueue
	thread for data transfer.
	(st_read_done_worker): New function.
	(st_read_done): Enqueue transfer or call st_read_done_worker.
	(st_write_done_worker): New function.
	(st_write_done): Enqueue transfer or call st_read_done_worker.
	(st_wait): Document as no-op for compatibility reasons.
	(st_wait_async): New function.
	* io/unit.c (insert_unit): Use macros LOCK, UNLOCK and TRYLOCK;
	add NOTE where necessary.
	(get_gfc_unit): Likewise.
	(init_units): Likewise.
	(close_unit_1): Likewise. Call async_close if asynchronous.
	(close_unit): Use macros LOCK and UNLOCK.
	(finish_last_advance_record): Likewise.
	(newunit_alloc): Likewise.
	* io/unix.c (find_file): Likewise.
	(flush_all_units_1): Likewise.
	(flush_all_units): Likewise.
	* libgfortran.h (generate_error_common): Add prototype.
	* runtime/error.c: Include io.h and async.h.
	(generate_error_common): New function.

2018-08-21  Nicolas Koenig  <koenigni@gcc.gnu.org>
	Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* testsuite/libgomp.fortran/async_io_1.f90: New test.
	* testsuite/libgomp.fortran/async_io_2.f90: New test.
	* testsuite/libgomp.fortran/async_io_3.f90: New test.
	* testsuite/libgomp.fortran/async_io_4.f90: New test.
	* testsuite/libgomp.fortran/async_io_5.f90: New test.
	* testsuite/libgomp.fortran/async_io_6.f90: New test.
	* testsuite/libgomp.fortran/async_io_7.f90: New test.


Co-Authored-By: Thomas Koenig <tkoenig@gcc.gnu.org>

From-SVN: r263750

8 files changed, 368 insertions, 0 deletions

diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index f54a695..e2ec2e8 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,15 @@
+2018-08-21  Nicolas Koenig  <koenigni@gcc.gnu.org>
+	Thomas Koenig <tkoenig@gcc.gnu.org>
+
+	PR fortran/25829
+	* testsuite/libgomp.fortran/async_io_1.f90: New test.
+	* testsuite/libgomp.fortran/async_io_2.f90: New test.
+	* testsuite/libgomp.fortran/async_io_3.f90: New test.
+	* testsuite/libgomp.fortran/async_io_4.f90: New test.
+	* testsuite/libgomp.fortran/async_io_5.f90: New test.
+	* testsuite/libgomp.fortran/async_io_6.f90: New test.
+	* testsuite/libgomp.fortran/async_io_7.f90: New test.
+
 2018-08-13  Cesar Philippidis  <cesar@codesourcery.com>
 	    Tom de Vries  <tdevries@suse.de>
 
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_1.f90 b/libgomp/testsuite/libgomp.fortran/async_io_1.f90
new file mode 100644
index 0000000..07721bb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_1.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+!TODO: Move these testcases to gfortran testsuite
+! once compilation with pthreads is supported there
+! Check basic functionality of async I/O
+program main
+  implicit none
+  integer:: i=1, j=2, k, l
+  real :: a, b, c, d
+  character(3), parameter:: yes="yes"
+  character(4) :: str
+  complex :: cc, dd
+  integer, dimension(4):: is = [0, 1, 2, 3]
+  integer, dimension(4):: res
+  character(10) :: inq
+
+  open (10, file='a.dat', asynchronous=yes)
+  cc = (1.5, 0.5)
+  inquire (10,asynchronous=inq)
+  if (inq /= "YES") stop 1
+  write (10,*,asynchronous=yes) 4, 3
+  write (10,*,asynchronous=yes) 2, 1
+  write (10,*,asynchronous=yes) 1.0, 3.0
+  write (10,'(A)', asynchronous=yes) 'asdf'
+  write (10,*, asynchronous=yes) cc
+  close (10)
+  open (20, file='a.dat', asynchronous=yes)
+  read (20, *, asynchronous=yes) i, j
+  read (20, *, asynchronous=yes) k, l
+  read (20, *, asynchronous=yes) a, b
+  read (20,'(A4)',asynchronous=yes) str
+  read (20,*, asynchronous=yes) dd
+  wait (20)
+  if (i /= 4 .or. j /= 3) stop 2
+  if (k /= 2 .or. l /= 1) stop 3
+  if (a /= 1.0 .or. b /= 3.0) stop 4
+  if (str /= 'asdf') stop 5
+  if (cc /= dd) stop 6
+  close (20,status="delete")
+
+  open(10, file='c.dat', asynchronous=yes) 
+  write(10, *, asynchronous=yes) is
+  close(10)
+  open(20, file='c.dat', asynchronous=yes) 
+  read(20, *, asynchronous=yes) res
+  wait (20)
+  if (any(res /= is)) stop 7
+  close (20,status="delete")
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_2.f90 b/libgomp/testsuite/libgomp.fortran/async_io_2.f90
new file mode 100644
index 0000000..440d46e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_2.f90
@@ -0,0 +1,18 @@
+! { dg-do  run }
+!TODO: Move these testcases to gfortran testsuite
+! once compilation with pthreads is supported there
+program main
+  implicit none
+  integer :: i, ios
+  character(len=100) :: iom
+  open (10,file="tst.dat")
+  write (10,'(A4)') 'asdf'
+  close(10)
+  i = 234
+  open(10,file="tst.dat", asynchronous="yes")
+  read (10,'(I4)',asynchronous="yes") i
+  iom = ' '
+  wait (10,iostat=ios,iomsg=iom)
+  if (iom == ' ') stop 1
+  close(10,status="delete")
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_3.f90 b/libgomp/testsuite/libgomp.fortran/async_io_3.f90
new file mode 100644
index 0000000..7d51248
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_3.f90
@@ -0,0 +1,16 @@
+
+!TODO: Move these testcases to gfortran testsuite
+! once compilation with pthreads is supported there
+! { dg-do run }
+program main
+  integer :: i
+  open (10,file="tst.dat")
+  write (10,'(A4)') 'asdf'
+  close(10)
+  i = 234
+  open(10,file="tst.dat", asynchronous="yes")
+  read (10,'(I4)',asynchronous="yes") i
+  wait(10)
+end program main
+! { dg-output "Fortran runtime error: Bad value during integer read" }
+! { dg-final { remote_file build delete "tst.dat" } }
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_4.f90 b/libgomp/testsuite/libgomp.fortran/async_io_4.f90
new file mode 100644
index 0000000..a21ffae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_4.f90
@@ -0,0 +1,90 @@
+! { 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
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_5.f90 b/libgomp/testsuite/libgomp.fortran/async_io_5.f90
new file mode 100644
index 0000000..916e78a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_5.f90
@@ -0,0 +1,132 @@
+! { dg-do run }
+!TODO: Move these testcases to gfortran testsuite
+! once compilation with pthreads is supported there
+! PR55818 Reading a REAL from a file which doesn't end in a new line fails
+! Test case from PR reporter.
+implicit none
+integer :: stat
+!integer :: var ! << works
+real    :: var ! << fails
+character(len=10)    :: cvar ! << fails
+complex :: cval
+logical :: lvar
+
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "1", new_line("")
+write(99) "2", new_line("")
+write(99) "3"
+close(99)
+
+! Test character kind
+open(99, file="test.dat")
+read (99,*, iostat=stat) cvar
+if (stat /= 0 .or. cvar /= "1") STOP 1
+read (99,*, iostat=stat) cvar
+if (stat /= 0 .or. cvar /= "2") STOP 2
+read (99,*, iostat=stat) cvar              ! << FAILS: stat /= 0
+if (stat /= 0 .or. cvar /= "3") STOP 3 ! << aborts here
+
+! Test real kind
+rewind(99)
+read (99,*, iostat=stat) var
+if (stat /= 0 .or. var /= 1.0) STOP 4
+read (99,*, iostat=stat) var
+if (stat /= 0 .or. var /= 2.0) STOP 5
+read (99,*, iostat=stat) var ! << FAILS: stat /= 0
+if (stat /= 0 .or. var /= 3.0) STOP 6
+close(99, status="delete")
+
+! Test real kind with exponents
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "1.0e3", new_line("")
+write(99) "2.0e-03", new_line("")
+write(99) "3.0e2"
+close(99)
+
+open(99, file="test.dat")
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 7
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 8
+read (99,*) var ! << FAILS: stat /= 0
+if (stat /= 0) STOP 9
+close(99, status="delete")
+
+! Test logical kind
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "Tru", new_line("")
+write(99) "fal", new_line("")
+write(99) "t"
+close(99)
+
+open(99, file="test.dat")
+read (99,*, iostat=stat) lvar
+if (stat /= 0 .or. (.not.lvar)) STOP 10
+read (99,*, iostat=stat) lvar
+if (stat /= 0 .or. lvar) STOP 11
+read (99,*) lvar ! << FAILS: stat /= 0
+if (stat /= 0 .or. (.not.lvar)) STOP 12
+close(99, status="delete")
+
+! Test combinations of Inf and Nan
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "infinity", new_line("")
+write(99) "nan", new_line("")
+write(99) "infinity"
+close(99)
+
+open(99, file="test.dat")
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 13
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 14
+read (99,*) var          ! << FAILS: stat /= 0
+if (stat /= 0) STOP 1! << aborts here
+close(99, status="delete")
+
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "infinity", new_line("")
+write(99) "inf", new_line("")
+write(99) "nan"
+close(99)
+
+open(99, file="test.dat")
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 15
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 16
+read (99,*) var          ! << FAILS: stat /= 0
+if (stat /= 0) STOP 2! << aborts here
+close(99, status="delete")
+
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "infinity", new_line("")
+write(99) "nan", new_line("")
+write(99) "inf"
+close(99)
+
+open(99, file="test.dat")
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 17
+read (99,*, iostat=stat) var
+if (stat /= 0) STOP 18
+read (99,*) var          ! << FAILS: stat /= 0
+if (stat /= 0) STOP 3! << aborts here
+close(99, status="delete")
+
+! Test complex kind
+open(99, file="test.dat", access="stream", form="unformatted", status="new")
+write(99) "(1,2)", new_line("")
+write(99) "(2,3)", new_line("")
+write(99) "(4,5)"
+close(99)
+
+open(99, file="test.dat")
+read (99,*, iostat=stat) cval
+if (stat /= 0 .or. cval /= cmplx(1,2)) STOP 19
+read (99,*, iostat=stat) cval
+if (stat /= 0 .or. cval /= cmplx(2,3)) STOP 20
+read (99,*, iostat=stat) cval      ! << FAILS: stat /= 0, value is okay
+if (stat /= 0 .or. cval /= cmplx(4,5)) STOP 21
+close(99, status="delete")
+end
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_6.f90 b/libgomp/testsuite/libgomp.fortran/async_io_6.f90
new file mode 100644
index 0000000..f19c037
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_6.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!TODO: Move these testcases to gfortran testsuite
+! once compilation with pthreads is supported there
+! PR 22390 Implement flush statement
+program flush_1
+
+   character(len=256) msg
+   integer ios
+
+   open (unit=10, access='SEQUENTIAL', status='SCRATCH')
+
+   write (10, *) 42
+   flush 10
+
+   write (10, *) 42
+   flush(10)
+
+   write (10, *) 42
+   flush(unit=10, iostat=ios)
+   if (ios /= 0) STOP 1
+
+   write (10, *) 42
+   flush (unit=10, err=20)
+   goto 30
+20 STOP 2
+30 continue
+
+   call flush(10)
+
+end program flush_1
diff --git a/libgomp/testsuite/libgomp.fortran/async_io_7.f90 b/libgomp/testsuite/libgomp.fortran/async_io_7.f90
new file mode 100644
index 0000000..a7ce9ba
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/async_io_7.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+!TODO: Move these testcases to gfortran testsuite
+! once compilation with pthreads is supported there
+! PR40008 F2008: Add NEWUNIT= for OPEN statement 
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program newunit_1
+  character(len=25) :: str
+  integer(1) :: myunit, myunit2
+  myunit = 25
+  str = "bad"
+  open(newunit=myunit, status="scratch")
+  open(newunit = myunit2, file="newunit_1file")
+  write(myunit,'(e24.15e2)') 1.0d0
+  write(myunit2,*) "abcdefghijklmnop"
+  flush(myunit)
+  rewind(myunit)
+  rewind(myunit2)
+  read(myunit2,'(a)') str
+  if (str.ne." abcdefghijklmnop") STOP 1
+  close(myunit)
+  close(myunit2, status="delete")
+end program newunit_1