2b4c906561
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
133 lines
3.7 KiB
Fortran
133 lines
3.7 KiB
Fortran
! { 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
|