From 0fc1c4290bbeb00a66621a1596db297bbed05dc2 Mon Sep 17 00:00:00 2001 From: Nicolas Koenig Date: Wed, 25 Jul 2018 19:34:33 +0000 Subject: [PATCH] re PR fortran/25829 ([F03] Asynchronous IO support) 2018-07-25 Nicolas Koenig Thomas Koenig 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 --- libgomp/testsuite/libgomp.fortran/async_io_1.f90 | 48 +++++++++ libgomp/testsuite/libgomp.fortran/async_io_2.f90 | 18 ++++ libgomp/testsuite/libgomp.fortran/async_io_3.f90 | 16 +++ libgomp/testsuite/libgomp.fortran/async_io_4.f90 | 90 ++++++++++++++++ libgomp/testsuite/libgomp.fortran/async_io_5.f90 | 132 +++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/async_io_6.f90 | 30 ++++++ libgomp/testsuite/libgomp.fortran/async_io_7.f90 | 22 ++++ 7 files changed, 356 insertions(+) create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_4.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_5.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_6.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/async_io_7.f90 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 00000000000..07721bb230a --- /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 00000000000..440d46e9463 --- /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 00000000000..7d5124868cf --- /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 00000000000..a21ffaef478 --- /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 00000000000..916e78aa001 --- /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 00000000000..f19c0379202 --- /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 00000000000..a7ce9ba47a7 --- /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 +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 -- 2.11.4.GIT