re PR libfortran/24719 (Nonadvancing read does not read more than 1 line)

2005-11-11  Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/24719
	gfortran.dg/read_noadvance.f90: New test.

	PR libgfortran/24699
	gfortran.dg/fmt_t_2.f90: New test.

	PR libgfortran/24785
	gfortran.dg/read_x_eor.f90: New test.

	PR libgfortran/24584
	gfortran.dg/namelist_empty.f90: Rename test.

	PR libgfortran/24489
	gfortran/read_eor.f90: Rename test.

From-SVN: r106798

diff --git a/gcc/testsuite/gfortran.dg/fmt_t_2.f90 b/gcc/testsuite/gfortran.dg/fmt_t_2.f90
new file mode 100644 (file)
index 0000000..c2b8694
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_2.f90
@@ -0,0 +1,27 @@
+! { dg-options "" }
+! { dg-do run }
+! pr24699, handle end-of-record on READ with T format
+! test contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+      character*132 :: foost1, foost2, foost3
+      open (11, status="scratch", action="readwrite")
+      write(11, '(a)') "ab cdefghijkl mnop qrst"
+      write(11, '(a)') "123456789 123456789 123456789"
+      write(11, '(a)') "  Now is the time for all good."
+      rewind(11)
+      
+      read (11, '(a040,t1,040a)', end = 999)  foost1 , foost2
+      if (foost1.ne.foost2) call abort()
+
+      read (11, '(a032,t2,a032t3,a032)', end = 999)  foost1 , foost2, foost3
+      if (foost1(1:32).ne."123456789 123456789 123456789   ") call abort()
+      if (foost2(1:32).ne."23456789 123456789 123456789    ") call abort()
+      if (foost3(1:32).ne."3456789 123456789 123456789     ") call abort()
+         
+      read (11, '(a017,t1,a0017)', end = 999)  foost1 , foost2
+      if (foost1.ne.foost2) call abort()
+      if (foost2(1:17).ne."  Now is the time ") call abort()
+      goto 1000
+ 999  call abort()
+ 1000 continue
+      close(11)
+      end

diff --git a/gcc/testsuite/gfortran.dg/namelist_empty.f90 b/gcc/testsuite/gfortran.dg/namelist_empty.f90
new file mode 100644 (file)
index 0000000..12e72ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_empty.f90
@@ -0,0 +1,17 @@
+! pr24584, segfault on namelist reading an empty string
+! Contributed by Jerry DeLisle  <jvdelisle@verizon.net> 
+      implicit none 
+      character*20   temp
+      character(len=10) var
+      namelist /input/ var
+      var = 'Howdy'
+      open(unit=7, status="scratch")
+      temp = '   var='''''  ! var='' in the file
+      write(7,'(A6)') '&INPUT'
+      write(7,'(A10)') temp
+      write(7,'(A1)') '/'
+      rewind(7)
+      read(7,NML=input)
+      close(7)
+      if (var.ne.'') call abort
+      end

diff --git a/gcc/testsuite/gfortran.dg/read_eor.f90 b/gcc/testsuite/gfortran.dg/read_eor.f90
new file mode 100644 (file)
index 0000000..f332755
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eor.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR24489 Assure that read does not go past the end of record. The width of
+! the format specifier is 8, but the internal unit record length is 4 so only
+! the first 4 characters should be read.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program pr24489
+  character*4, dimension(8) :: abuf = (/"0123","4567","89AB","CDEF", &
+                                        "0123","4567","89AB","CDEF"/)
+  character*4, dimension(2,4) :: buf
+  character*8 :: a
+  equivalence (buf,abuf)
+  read(buf, '(a8)') a
+  if (a.ne.'0123') call abort()
+end program pr24489

diff --git a/gcc/testsuite/gfortran.dg/read_noadvance.f90 b/gcc/testsuite/gfortran.dg/read_noadvance.f90
new file mode 100644 (file)
index 0000000..e55763a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_noadvance.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! pr24719, non-advancing read should read more than one line
+! test contributed by jerry delisle <jvdelisle@gcc.gnu.org>
+      implicit none
+      character(1) :: chr
+      character(20) :: correct = 'foo: bar 123abc'
+      integer :: i
+      open(unit = 11, status = "scratch", action="readwrite")
+      write(11,'(a)') "foo: bar"
+      write(11,'(a)') "123abc"
+      rewind(11)
+      i = 0
+      do
+        i = i + 1
+10      read(unit = 11, fmt = '(a)', advance = 'no', end = 99, eor = 11) chr
+        if (chr.ne.correct(i:i)) call abort()
+        cycle
+11      continue
+      end do
+99    close(11)
+      end

diff --git a/gcc/testsuite/gfortran.dg/read_x_eor.f90 b/gcc/testsuite/gfortran.dg/read_x_eor.f90
new file mode 100644 (file)
index 0000000..064835a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_x_eor.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! ( dg-output "^" }
+!
+! Test fix for pr24785 - EOR used to scrub the 2X.
+! Reduced from PR example submitted by Harald Anlauf <anlauf@gmx.de>
+!
+     program x_with_advance_bug
+     write (*,'(A,2X)',  advance="no") "<"
+     write (*,'(A)') ">" ! { dg-output "<  >" }
+     end