re PR fortran/25828 ([f2003] ACCESS='STREAM' io support)

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.

From-SVN: r116173

9 files changed, 225 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index acf6d70..88c66db 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,15 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/streamio_1.f90 b/gcc/testsuite/gfortran.dg/streamio_1.f90
new file mode 100644
index 0000000..5a853fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_1.f90
@@ -0,0 +1,18 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_2.f90 b/gcc/testsuite/gfortran.dg/streamio_2.f90
new file mode 100644
index 0000000..a7d5d3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_2.f90
@@ -0,0 +1,19 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_3.f90 b/gcc/testsuite/gfortran.dg/streamio_3.f90
new file mode 100644
index 0000000..b96e5fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_3.f90
@@ -0,0 +1,18 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_4.f90 b/gcc/testsuite/gfortran.dg/streamio_4.f90
new file mode 100644
index 0000000..871bafe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_4.f90
@@ -0,0 +1,42 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_5.f90 b/gcc/testsuite/gfortran.dg/streamio_5.f90
new file mode 100644
index 0000000..6fdf707
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_5.f90
@@ -0,0 +1,32 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_6.f90 b/gcc/testsuite/gfortran.dg/streamio_6.f90
new file mode 100644
index 0000000..3857667
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_6.f90
@@ -0,0 +1,32 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_7.f90 b/gcc/testsuite/gfortran.dg/streamio_7.f90
new file mode 100644
index 0000000..7a7b277
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_7.f90
@@ -0,0 +1,18 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/streamio_8.f90 b/gcc/testsuite/gfortran.dg/streamio_8.f90
new file mode 100644
index 0000000..1e5e16f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_8.f90
@@ -0,0 +1,34 @@
+! { 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