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
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
|