mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-05 19:51:34 +08:00
re PR fortran/25829 ([F03] Asynchronous IO support)
2018-07-25 Nicolas Koenig <koenigni@gcc.gnu.org> Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/25829 * testsuite/libgomp.fortran/async_io_1.f90: Really commit. * testsuite/libgomp.fortran/async_io_2.f90: Really commit. * testsuite/libgomp.fortran/async_io_3.f90: Really commit. * testsuite/libgomp.fortran/async_io_4.f90: Really commit. * testsuite/libgomp.fortran/async_io_5.f90: Really commit. * testsuite/libgomp.fortran/async_io_6.f90: Really commit. * testsuite/libgomp.fortran/async_io_7.f90: Really commit. From-SVN: r262979
This commit is contained in:
Nicolas Koenig
parent
b1f45884f6
commit
0fc1c4290b
48
libgomp/testsuite/libgomp.fortran/async_io_1.f90
Normal file
48
libgomp/testsuite/libgomp.fortran/async_io_1.f90
Normal file
@ -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
|
||||
18
libgomp/testsuite/libgomp.fortran/async_io_2.f90
Normal file
18
libgomp/testsuite/libgomp.fortran/async_io_2.f90
Normal file
@ -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
|
||||
16
libgomp/testsuite/libgomp.fortran/async_io_3.f90
Normal file
16
libgomp/testsuite/libgomp.fortran/async_io_3.f90
Normal file
@ -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" } }
|
||||
90
libgomp/testsuite/libgomp.fortran/async_io_4.f90
Normal file
90
libgomp/testsuite/libgomp.fortran/async_io_4.f90
Normal file
@ -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
|
||||
132
libgomp/testsuite/libgomp.fortran/async_io_5.f90
Normal file
132
libgomp/testsuite/libgomp.fortran/async_io_5.f90
Normal file
@ -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
|
||||
30
libgomp/testsuite/libgomp.fortran/async_io_6.f90
Normal file
30
libgomp/testsuite/libgomp.fortran/async_io_6.f90
Normal file
@ -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
|
||||
22
libgomp/testsuite/libgomp.fortran/async_io_7.f90
Normal file
22
libgomp/testsuite/libgomp.fortran/async_io_7.f90
Normal file
@ -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
|
||||
Loading…
x
Reference in New Issue
Block a user