[patch] Fix libgfortran/29627

[Thomas Koenig]

:ADDPATCH fortran:

Hello world,

this is a fix for PR 29627, including a little cleanup.
Regression-tested against 4.3.0 on i686-pc-linux-gnu.

OK for trunk?  What about 4.2 and 4.1?

	Thomas

2006-10-29  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.
-------------- next part --------------
Index: runtime/error.c
===================================================================
--- runtime/error.c	(revision 117910)
+++ runtime/error.c	(working copy)
@@ -435,6 +435,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;
Index: libgfortran.h
===================================================================
--- libgfortran.h	(revision 117910)
+++ libgfortran.h	(working copy)
@@ -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;
Index: io/transfer.c
===================================================================
--- io/transfer.c	(revision 117910)
+++ io/transfer.c	(working copy)
@@ -359,82 +359,73 @@ read_block (st_parameter_dt *dtp, int *l
 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, 
       /* 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++)
-------------- next part --------------
! { 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