+2006-08-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/25828
+ * gfortran.dg/streamio_1.f90: New test.
+ * gfortran.dg/streamio_2.f90: New test.
+ * gfortran.dg/streamio_3.f90: New test.
+ * gfortran.dg/streamio_4.f90: New test.
+ * gfortran.dg/streamio_5.f90: New test.
+ * gfortran.dg/streamio_6.f90: New test.
+ * gfortran.dg/streamio_7.f90: New test.
+ * gfortran.dg/streamio_8.f90: New test.
+
2006-08-15 Danny Smith <dannysmith@users.sourceforge.net>
PR c/28287
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 1
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+PROGRAM stream_io_1
+ IMPLICIT NONE
+ integer(kind=4) i
+ real(kind=8) r
+ OPEN(UNIT=11, ACCESS="stream")
+ WRITE(11) "first"
+ WRITE(11) "second"
+ WRITE(11) 1234567
+ write(11) 3.14159_8
+ read(11, pos=12)i
+ if (i.ne.1234567) call abort()
+ read(11) r
+ if (r-3.14159 .gt. 0.00001) call abort()
+ CLOSE(UNIT=11, status="delete")
+END PROGRAM stream_io_1
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 2
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+PROGRAM readUstream
+ IMPLICIT NONE
+ CHARACTER*3 :: string
+ INTEGER :: n
+ string = "123"
+ n = 13579
+ OPEN(UNIT=11, FILE="streamio2", ACCESS="STREAM")
+ WRITE(11) "first"
+ WRITE(11) "second"
+ WRITE(11) 7
+ READ(11, POS=3) string
+ READ(11, POS=12) n
+ if (string.ne."rst") call abort()
+ if (n.ne.7) call abort()
+ close(unit=11, status="delete")
+END PROGRAM readUstream
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 3, tests read_x and inquire.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamio_3
+ implicit none
+ integer :: i(6),j
+ character(10) :: myaccess
+ open(10, access="stream", form="formatted")
+ i = (/(j,j=1,6)/)
+ write(10,'(3(2x,i4/)/3(3x,i6/))') i
+ i = 0
+ rewind(10)
+ read(10,'(3(2x,i4/)/3(3x,i6/))') i
+ if (any(i.ne.(/(j,j=1,6)/))) call abort()
+ inquire(unit=10, access=myaccess)
+ if (myaccess.ne."STREAM") call abort()
+ close(10,status="delete")
+end program streamio_3
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 4, Tests string read and writes, single byte.
+! Verifies buffering is working correctly and position="append"
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamtest
+ implicit none
+ character(1) :: lf = char(10)
+ character(1) :: tchar
+ integer :: i,j,k
+ integer, parameter :: lines = 5231
+
+ open(10, file="teststream", access="stream", form="formatted")
+
+ do i=1,lines
+ do j=0,9
+ write(10,"(i5)") j
+ end do
+ write(10,"(a)") lf
+ end do
+
+ close(10)
+
+ open(10, file="teststream", access="stream",&
+ &form="formatted", position="append")
+ do i=1,lines
+ do j=0,9
+ write(10,"(i5)") j
+ end do
+ write(10,"(a)") lf
+ end do
+ rewind(10)
+ do i=1,lines
+ do j=0,9
+ read(10,"(i5)") k
+ if (k.ne.j) call abort()
+ end do
+ read(10,"(a)") tchar
+ if (tchar.ne.lf) call abort()
+ end do
+
+ close(10,status="delete")
+end program streamtest
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 5, unformatted single byte
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamtest5
+ implicit none
+ character(1) :: lf = char(10)
+ character(1) :: tchar
+ integer :: i,j,k
+
+ open(10, file="teststream", access="stream", form="unformatted")
+
+ do i=1,1229
+ do j=0,9
+ write(10) j
+ end do
+ write(10) lf
+ end do
+
+ close(10)
+
+ open(10, file="teststream", access="stream", form="unformatted")
+
+ do i=1,1229
+ do j=0,9
+ read(10) k
+ if (k.ne.j) call abort()
+ end do
+ read(10) tchar
+ if (tchar.ne.lf) call abort()
+ end do
+ close(10,status="delete")
+end program streamtest5
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 6, random writes and reads.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamio_6
+ implicit none
+ integer, dimension(100) :: a
+ character(1) :: c
+ integer :: i,j,k,ier
+ real :: x
+ data a / 13, 9, 34, 41, 25, 98, 6, 12, 11, 44, 79, 3,&
+ & 64, 61, 77, 57, 59, 2, 92, 38, 71, 64, 31, 60, 28, 90, 26,&
+ & 97, 47, 26, 48, 96, 95, 82, 100, 90, 45, 71, 71, 67, 72,&
+ & 76, 94, 49, 85, 45, 100, 22, 96, 48, 13, 23, 40, 14, 76, 99,&
+ & 96, 90, 65, 2, 8, 60, 96, 19, 45, 1, 100, 48, 91, 20, 92,&
+ & 72, 81, 59, 24, 37, 43, 21, 54, 68, 31, 19, 79, 63, 41,&
+ & 42, 12, 10, 62, 43, 9, 30, 9, 54, 35, 4, 5, 55, 3, 94 /
+
+ open(unit=15,file="teststream",access="stream",form="unformatted")
+ do i=1,100
+ k = a(i)
+ write(unit=15, pos=k) achar(k)
+ enddo
+ do j=1,100
+ read(unit=15, pos=a(j), iostat=ier) c
+ if (ier.ne.0) then
+ call abort
+ else
+ if (achar(a(j)) /= c) call abort
+ endif
+ enddo
+ close(unit=15, status="delete")
+end program streamio_6
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 7, Array writes and reads.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamtest
+ implicit none
+ character(1) :: lf = char(10)
+ character(1) :: tchar
+ integer :: i,j,k
+ real(kind=4), dimension(100,100) :: anarray
+ open(10, file="teststream", access="stream", form="unformatted")
+ anarray = 3.14159
+ write(10) anarray
+ anarray = 0.0
+ read(10, pos=1) anarray
+ anarray = abs(anarray - 3.14159)
+ if (any(anarray.gt.0.00001)) call abort()
+ close(10,status="delete")
+end program streamtest
\ No newline at end of file
--- /dev/null
+! { dg-do run }
+! PR25828 Stream IO test 8
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+PROGRAM stream_io_8
+ IMPLICIT NONE
+ integer(kind=8) mypos
+ character(10) mystring
+ real(kind=8) r
+ mypos = 0
+ mystring = "not yet"
+ r = 12.25
+ OPEN(UNIT=11, ACCESS="stream")
+ inquire(unit=11, pos=mypos)
+ if (mypos.ne.1) call abort()
+ WRITE(11) "first"
+ inquire(unit=11, pos=mypos)
+ if (mypos.ne.6) call abort()
+ WRITE(11) "second"
+ inquire(unit=11, pos=mypos)
+ if (mypos.ne.12) call abort()
+ WRITE(11) 1234567
+ inquire(unit=11, pos=mypos)
+ if (mypos.ne.16) call abort()
+ write(11) r
+ r = 0.0
+ inquire (11, pos=mypos)
+ read(11,pos=16)r
+ if (r.ne.12.25) call abort()
+ inquire(unit=11, pos=mypos)
+ inquire(unit=11, access=mystring)
+ if (mypos.ne.24) call abort()
+ if (mystring.ne."STREAM") call abort()
+ CLOSE(UNIT=11, status="delete")
+END PROGRAM stream_io_8
\ No newline at end of file
OSDN Git Service
