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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/unf_short_record_1.f90

+! { 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

libgfortran/ChangeLog

+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

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++)

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;

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;