[multiple changes]

2005-04-10  Thomas Koenig <Thomas.Koenig@online.de>

        PR libfortran/17992
        PR libfortran/19568
        PR libfortran/19595
        PR libfortran/20005
        PR libfortran/20092
        PR libfortran/20131
        PR libfortran/20138
        PR libfortran/20661
        PR libfortran/20744
        * io/transfer.c (top level): eor_condition: New static variable.
        (read_sf): Remove unnecessary zeroing of buffer (there is enough
        information in its length).
        Return a string of length 0 (to be padded by caller) if EOR was
        seen previously.
        Remove erroneous special casing of EOR for standard input.
        Set eor_condition for non-advancing I/O if an end of line was
        detected.
        Increment ioparm.size if necessary.
        (formatted_transfer):  Skip the function if there is an EOR condition.
        (data_transfer_init):  Initialize eor_condition to zero (false).
        (next_record_r):  Clear sf_seen_eor if a \n has been seen already.
        (finalize_transfer):  If there is an EOR condition, raise the error.

2005-04-10   Thomas Koenig  <Thomas.Koenig@online.de>

        * eor_handling_1.f90: New test case.
        * eor_handling_2.f90: New test case.
        * eor_handling_3.f90: New test case.
        * eor_handling_4.f90: New test case.
        * eor_handling_5.f90: New test case.
        * noadv_size.f90: New test case.
        * pad_no.f90: New test case.

From-SVN: r97943

10 files changed, 174 insertions, 8 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 59255c0..a55aec8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2005-04-10  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* eor_handling_1.f90: New test case.
+	* eor_handling_2.f90: New test case.
+	* eor_handling_3.f90: New test case.
+	* eor_handling_4.f90: New test case.
+	* eor_handling_5.f90: New test case.
+	* noadv_size.f90: New test case.
+	* pad_no.f90: New test case.
+
 2005-04-10  Richard Sandiford  <rsandifo@redhat.com>
 
 	* gcc.c-torture/execute/20050410-1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_1.f90 b/gcc/testsuite/gfortran.dg/eor_handling_1.f90
new file mode 100644
index 0000000..241f8a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 17992:  Reading an empty file should yield zero with pad='YES'
+! (which is the default).
+! Test case supplied by milan@cmm.ki.si.
+program main
+  open(77,status='scratch')
+  write(77,'(A)') '',''
+  rewind(77)
+  i = 42
+  j = 42
+  read(77,'(/2i2)') i,j
+  if (i /= 0 .or. j /= 0) call abort
+  close(77)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_2.f90 b/gcc/testsuite/gfortran.dg/eor_handling_2.f90
new file mode 100644
index 0000000..5eb62f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_2.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 19568:  Don't read across end of line when the format is longer
+!            than the line length and pad='yes' (default)
+program main
+  character(len=1) c1(10),c2(10)
+  open(77,status='scratch')
+  write(77,'(A)') 'Line 1','Line 2','Line 3'
+  rewind(77)
+  read(77,'(10A1)'), c1
+  read(77,'(10A1)'), c2
+  if (c1(1) /= 'L' .or. c2(1) /= 'L') call abort
+  close(77)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_3.f90 b/gcc/testsuite/gfortran.dg/eor_handling_3.f90
new file mode 100644
index 0000000..4225e86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_3.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 19595:  Handle end-of-record condition with pad=yes (default)
+program main
+  integer i1, i2
+  open(77,status='scratch')
+  write (77,'(A)') '123','456'
+  rewind(77)
+  read(77,'(2I2)',advance='no',eor=100) i1,i2
+  call abort
+100 continue
+  if (i1 /= 12 .or. i2 /= 3) call abort
+  close(77)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_4.f90 b/gcc/testsuite/gfortran.dg/eor_handling_4.f90
new file mode 100644
index 0000000..300c10b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_4.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR 20092, 20131:  Handle end-of-record condition with pad=yes (default)
+! for standard input.  This test case only really tests  anything if,
+! by changing unit 5, you get to manipulate the standard input.
+program main
+  character(len=1) a(80)
+  close(5)
+  open(5,status="scratch")
+  write(5,'(A)') 'one', 'two', 's'
+  rewind(5)
+  do i=1,4
+     read(5,'(80a1)') a
+     if (a(1) == 's') goto 100
+  end do
+  call abort
+100 continue
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_5.f90 b/gcc/testsuite/gfortran.dg/eor_handling_5.f90
new file mode 100644
index 0000000..c116fb7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_5.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR 20661: Handle non-advancing I/O with iostat
+! Test case by Walt Brainerd, The Fortran Company
+
+program fc002
+   character(len=1) :: c
+   integer :: k,k2
+   character(len=*), parameter :: f="(a)"
+   open(11,status="scratch", iostat=k)
+   if (k /= 0) call abort
+   write(11,f) "x"
+   rewind (11)
+   read(11, f, advance="no", iostat=k) c
+   if (k /= 0) call abort
+   read(11, f, advance="no", iostat=k) c
+   if (k >= 0) call abort
+   read(11, f, advance="no", iostat=k2) c
+   if (k2 >= 0 .or. k == k2) call abort
+end program fc002
diff --git a/gcc/testsuite/gfortran.dg/noadv_size.f90 b/gcc/testsuite/gfortran.dg/noadv_size.f90
new file mode 100644
index 0000000..a3a88b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noadv_size.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 20774: Handle size parameter for non-advancing I/O correctly
+program main
+  open(77,status='scratch')
+  write(77,'(A)') '123'
+  rewind(77)
+  read(77,'(2I2)',advance='no',iostat=k,size=n) i1,i2
+  if (k >=0) call abort
+  if (n /= 3) call abort
+  if (i1 /= 12 .or. i2 /= 3) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pad_no.f90 b/gcc/testsuite/gfortran.dg/pad_no.f90
new file mode 100644
index 0000000..c023ade
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_no.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Test correct operation for pad='no'.
+program main
+  character(len=1) line(2)
+  line = 'x'
+  open(77,status='scratch',pad='no')
+  write(77,'(A)') 'a','b'
+  rewind(77)
+  read(77,'(2A)',iostat=i) line(1)
+  if (line(1) /= 'a' .or. line(2) /= 'x') call abort
+  rewind(77)
+  line = 'y'
+  read(77,'(2A)',iostat=i,advance='no') line
+  if (line(1) /= 'a' .or. line(2) /= 'y') call abort
+end program main
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 46fc3b3..fcb4ff3 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,28 @@
+2005-04-10  Thomas Koenig <Thomas.Koenig@online.de>
+
+	PR libfortran/17992
+	PR libfortran/19568
+	PR libfortran/19595
+	PR libfortran/20005
+	PR libfortran/20092
+	PR libfortran/20131
+	PR libfortran/20138
+	PR libfortran/20661
+	PR libfortran/20744
+	* io/transfer.c (top level): eor_condition: New static variable.
+	(read_sf): Remove unnecessary zeroing of buffer (there is enough
+	information in its length).
+	Return a string of length 0 (to be padded by caller) if EOR was
+	seen previously.
+	Remove erroneous special casing of EOR for standard input.
+	Set eor_condition for non-advancing I/O if an end of line was
+	detected.
+	Increment ioparm.size if necessary.
+	(formatted_transfer):  Skip the function if there is an EOR condition.
+	(data_transfer_init):  Initialize eor_condition to zero (false).
+	(next_record_r):  Clear sf_seen_eor if a \n has been seen already.
+	(finalize_transfer):  If there is an EOR condition, raise the error.
+
 2005-04-09  Bud Davis  <bdavis@gfortran.org>
             Steven G. Kargl <kargls@comcast.net>
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index f86a852..77e9439 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -79,6 +79,7 @@ export_proto(transfer_complex);
 
 gfc_unit *current_unit = NULL;
 static int sf_seen_eor = 0;
+static int eor_condition = 0;
 
 char scratch[SCRATCH_SIZE] = { };
 static char *line_buffer = NULL;
@@ -150,7 +151,13 @@ read_sf (int *length)
   else
     p = base = data;
 
-  memset(base,'\0',*length);
+  /* If we have seen an eor previously, return a length of 0.  The
+     caller is responsible for correctly padding the input field.  */
+  if (sf_seen_eor)
+    {
+      *length = 0;
+      return base;
+    }
 
   current_unit->bytes_left = options.default_recl;
   readlen = 1;
@@ -179,13 +186,16 @@ read_sf (int *length)
 
       if (readlen < 1 || *q == '\n' || *q == '\r')
 	{
-	  /* ??? What is this for?  */
-          if (current_unit->unit_number == options.stdin_unit)
-            {
-              if (n <= 0)
-                continue;
-            }
 	  /* Unexpected end of line.  */
+
+	  /* If we see an EOR during non-advancing I/O, we need to skip
+	     the rest of the I/O statement.  Set the corresponding flag.  */
+	  if (advance_status == ADVANCE_NO)
+	    eor_condition = 1;
+
+	  /* Without padding, terminate the I/O statement without assigning
+	     the value.  With padding, the value still needs to be assigned,
+	     so we can just continue with a short read.  */
 	  if (current_unit->flags.pad == PAD_NO)
 	    {
 	      generate_error (ERROR_EOR, NULL);
@@ -204,6 +214,9 @@ read_sf (int *length)
     }
   while (n < *length);
 
+  if (ioparm.size != NULL)
+    *ioparm.size += *length;
+
   return base;
 }
 
@@ -434,6 +447,11 @@ formatted_transfer (bt type, void *p, int len)
   if (type == BT_COMPLEX)
     type = BT_REAL;
 
+  /* If there's an EOR condition, we simulate finalizing the transfer
+     by doing nothing.  */
+  if (eor_condition)
+    return;
+
   for (;;)
     {
       /* If reversion has occurred and there is another real data item,
@@ -1121,6 +1139,7 @@ data_transfer_init (int read_flag)
   g.first_item = 1;
   g.item_count = 0;
   sf_seen_eor = 0;
+  eor_condition = 0;
 
   pre_position ();
 
@@ -1236,7 +1255,10 @@ next_record_r (int done)
       length = 1;
       /* sf_read has already terminated input because of an '\n'  */
       if (sf_seen_eor) 
-         break;
+	{
+	  sf_seen_eor=0;
+	  break;
+	}
 
       do
         {
@@ -1402,6 +1424,13 @@ next_record (int done)
 static void
 finalize_transfer (void)
 {
+
+  if (eor_condition)
+    {
+      generate_error (ERROR_EOR, NULL);
+      return;
+    }
+
   if (ioparm.library_return != LIBRARY_OK)
     return;