re PR libfortran/29627 ([4.1 only] partial unformatted reads shouldn't succeed)

2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29627
	* libgfortran.h: Add ERROR_SHORT_RECORD
	* runtime/error.c (translate_error): Add case
	for ERROR_SHORT_RECORD.
	* io/transfer.c (read_block_direct):  Separate codepaths
	for stream and record unformatted I/O.  Remove unneeded
	tests for standard input, padding and formatted I/O.
	If the record is short, read in as much data as possible,
	then raise the error.

2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29627
	* gfortran.dg/unf_short_record_1.f90:  New test.

From-SVN: r118341

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 53ed758..f6f95b3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/29627
+       * gfortran.dg/unf_short_record_1.f90:  New test.
+
 2006-10-31  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        PR fortran/29067

diff --git a/gcc/testsuite/gfortran.dg/unf_short_record_1.f90 b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
new file mode 100644 (file)
index 0000000..1bb6273
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR 29627 - partial reads of unformatted records
+program main
+  character a(3)
+  character(len=50) msg
+  open(10, form="unformatted", status="unknown")
+  write (10) 'a'
+  write (10) 'c'
+  a = 'b'
+  rewind 10
+  read (10, err=20, iomsg=msg) a
+  call abort
+20 continue
+  if (msg .ne. "Short record on unformatted read") call abort
+  if (a(1) .ne. 'a' .or. a(2) .ne. 'b' .or. a(3) .ne. 'b') call abort
+  close (10, status="delete")
+end program main

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6dd8270..54849e0 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/29627
+       * libgfortran.h: Add ERROR_SHORT_RECORD
+       * runtime/error.c (translate_error): Add case
+       for ERROR_SHORT_RECORD.
+       * io/transfer.c (read_block_direct):  Separate codepaths
+       for stream and record unformatted I/O.  Remove unneeded
+       tests for standard input, padding and formatted I/O.
+       If the record is short, read in as much data as possible,
+       then raise the error.
+
 2006-10-30  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/29452

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 46fae1b..b4c2bb6 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -359,82 +359,73 @@ read_block (st_parameter_dt *dtp, int *length)
 static void
 read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
 {
-  int *length;
-  void *data;
   size_t nread;
+  int short_record;
 
-  if (!is_stream_io (dtp))
+  if (is_stream_io (dtp))
     {
-      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
+      if (sseek (dtp->u.p.current_unit->s,
+                dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
        {
-         /* For preconnected units with default record length, set
-            bytes left to unit record length and proceed, otherwise
-            error.  */
-         if (dtp->u.p.current_unit->unit_number == options.stdin_unit
-             && dtp->u.p.current_unit->recl == DEFAULT_RECL)
-           dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
-         else
-           {
-             if (dtp->u.p.current_unit->flags.pad == PAD_NO)
-               {
-                 /* Not enough data left.  */
-                 generate_error (&dtp->common, ERROR_EOR, NULL);
-                 return;
-               }
-           }
-         
-         if (dtp->u.p.current_unit->bytes_left == 0)
-           {
-             dtp->u.p.current_unit->endfile = AT_ENDFILE;
-             generate_error (&dtp->common, ERROR_END, NULL);
-             return;
-           }
-
-         *nbytes = (size_t) dtp->u.p.current_unit->bytes_left;
+         generate_error (&dtp->common, ERROR_END, NULL);
+         return;
        }
 
-      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
-         dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
+      nread = *nbytes;
+      if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
        {
-         length = (int *) nbytes;
-         data = read_sf (dtp, length, 0);      /* Special case.  */
-         memcpy (buf, data, (size_t) *length);
+         generate_error (&dtp->common, ERROR_OS, NULL);
          return;
        }
 
-      dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
+      dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; 
+
+      if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
+       generate_error (&dtp->common, ERROR_END, NULL);   
+
+      return;
     }
-  else
+
+  /* Unformatted file with records */
+  if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
     {
-      if (sseek (dtp->u.p.current_unit->s,
-                dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+      short_record = 1;
+      nread = (size_t) dtp->u.p.current_unit->bytes_left;
+      *nbytes = nread;
+
+      if (dtp->u.p.current_unit->bytes_left == 0)
        {
+         dtp->u.p.current_unit->endfile = AT_ENDFILE;
          generate_error (&dtp->common, ERROR_END, NULL);
          return;
        }
     }
 
-  nread = *nbytes;
+  else
+    {
+      short_record = 0;
+      nread = *nbytes;
+    }
+
+  dtp->u.p.current_unit->bytes_left -= nread;
+
   if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
     {
       generate_error (&dtp->common, ERROR_OS, NULL);
       return;
     }
 
-  if (!is_stream_io (dtp))
+  if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
     {
-      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-       dtp->u.p.size_used += (gfc_offset) nread;
+      *nbytes = nread;
+      generate_error (&dtp->common, ERROR_END, NULL);
+      return;
     }
-  else
-    dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; 
 
-  if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
+  if (short_record)
     {
-      if (!is_stream_io (dtp))
-       generate_error (&dtp->common, ERROR_EOR, NULL);
-      else
-       generate_error (&dtp->common, ERROR_END, NULL);   
+      generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+      return;
     }
 }
 
@@ -595,7 +586,8 @@ unformatted_read (st_parameter_dt *dtp, bt type,
       /* By now, all complex variables have been split into their
         constituent reals.  For types with padding, we only need to
         read kind bytes.  We don't care about the contents
-        of the padding.  */
+        of the padding.  If we hit a short record, then sz is
+        adjusted accordingly, making later reads no-ops.  */
       
       sz = kind;
       for (i=0; i<nelems; i++)

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index e023f0e..ff94765 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -413,6 +413,7 @@ typedef enum
   ERROR_INTERNAL_UNIT,
   ERROR_ALLOCATION,
   ERROR_DIRECT_EOR,
+  ERROR_SHORT_RECORD,
   ERROR_LAST                   /* Not a real error, the last error # + 1.  */
 }
 error_codes;

diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index f8f76d3..245e04e 100644 (file)
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -436,6 +436,10 @@ translate_error (int code)
       p = "Write exceeds length of DIRECT access record";
       break;
 
+    case ERROR_SHORT_RECORD:
+      p = "Short record on unformatted read";
+      break;
+
     default:
       p = "Unknown error code";
       break;