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

	PR libgfortran/25545
	* io/transfer.c (write_block): Cleanup code paths between
	stream and non-stream I/O.
	(write_buf):  Cleanup.
	(read_block): Cleanup.
	(finalize_transfer): Call next_record for '$' edit descriptor handling
	of internal unit. Cleanup code for readability.


git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@118506 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 100 insertions, 113 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8b5eddff4ec..88d76c81ab0 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2006-11-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/25545
+	* io/transfer.c (write_block): Cleanup code paths between
+	stream and non-stream I/O.
+	(write_buf):  Cleanup.
+	(read_block): Cleanup.
+	(finalize_transfer): Call next_record for '$' edit descriptor handling
+	of internal unit. Cleanup code for readability.
+
 2006-11-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR libfortran/27895
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index b4c2bb65b0c..a4d456389b1 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -263,7 +263,16 @@ read_block (st_parameter_dt *dtp, int *length)
   char *source;
   int nread;
 
-  if (!is_stream_io (dtp))
+  if (is_stream_io (dtp))
+    {
+      if (sseek (dtp->u.p.current_unit->s,
+		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+	{
+	  generate_error (&dtp->common, ERROR_END, NULL);
+	  return NULL;
+	}
+    }
+  else
     {
       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length)
 	{
@@ -291,65 +300,38 @@ read_block (st_parameter_dt *dtp, int *length)
 
 	  *length = dtp->u.p.current_unit->bytes_left;
 	}
+    }
 
-      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
-	dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
-	  return read_sf (dtp, length, 0);	/* Special case.  */
-
-      dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
-
-      nread = *length;
-      source = salloc_r (dtp->u.p.current_unit->s, &nread);
+  if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
+      (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
+       dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
+    {
+      source = read_sf (dtp, length, 0);
+      dtp->u.p.current_unit->strm_pos +=
+	(gfc_offset) (*length + dtp->u.p.sf_seen_eor);
+      return source;
+    }
+  dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
 
-      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-	dtp->u.p.size_used += (gfc_offset) nread;
+  nread = *length;
+  source = salloc_r (dtp->u.p.current_unit->s, &nread);
 
-      if (nread != *length)
-	{				/* Short read, this shouldn't happen.  */
-	  if (dtp->u.p.current_unit->flags.pad == PAD_YES)
-	    *length = nread;
-	  else
-	    {
-	      generate_error (&dtp->common, ERROR_EOR, NULL);
-	      source = NULL;
-	    }
-	}
-    }
-  else
-    {
-      if (sseek (dtp->u.p.current_unit->s,
-		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, ERROR_END, NULL);
-	  return NULL;
-	}
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    dtp->u.p.size_used += (gfc_offset) nread;
 
-      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+  if (nread != *length)
+    {				/* Short read, this shouldn't happen.  */
+      if (dtp->u.p.current_unit->flags.pad == PAD_YES)
+	*length = nread;
+      else
 	{
-	  source = read_sf (dtp, length, 0);
-	  dtp->u.p.current_unit->strm_pos +=
-	    (gfc_offset) (*length + dtp->u.p.sf_seen_eor);
-	  return source;
+	  generate_error (&dtp->common, ERROR_EOR, NULL);
+	  source = NULL;
 	}
-      nread = *length;
-      source = salloc_r (dtp->u.p.current_unit->s, &nread);
+    }
 
-      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-	dtp->u.p.size_used += (gfc_offset) nread;
+  dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
 
-      if (nread != *length)
-	{				/* Short read, this shouldn't happen.  */
-	  if (dtp->u.p.current_unit->flags.pad == PAD_YES)
-	    *length = nread;
-	  else
-	    {
-	      generate_error (&dtp->common, ERROR_END, NULL);
-	      source = NULL;
-	    }
-	}
-
-      dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
-    }
   return source;
 }
 
@@ -440,7 +422,16 @@ write_block (st_parameter_dt *dtp, int length)
 {
   char *dest;
 
-  if (!is_stream_io (dtp))
+  if (is_stream_io (dtp))
+    {
+      if (sseek (dtp->u.p.current_unit->s,
+		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+	{
+	  generate_error (&dtp->common, ERROR_OS, NULL);
+	  return NULL;
+	}
+    }
+  else
     {
       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
 	{
@@ -458,41 +449,23 @@ write_block (st_parameter_dt *dtp, int length)
 	}
 
       dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
+    }
 
+  dest = salloc_w (dtp->u.p.current_unit->s, &length);
 
-      dest = salloc_w (dtp->u.p.current_unit->s, &length);
-  
-      if (dest == NULL)
-	{
-	  generate_error (&dtp->common, ERROR_END, NULL);
-	  return NULL;
-	}
-
-      if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
-	generate_error (&dtp->common, ERROR_END, NULL);
-
-      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-	dtp->u.p.size_used += (gfc_offset) length;
-    }
-  else
+  if (dest == NULL)
     {
-      if (sseek (dtp->u.p.current_unit->s,
-		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, ERROR_OS, NULL);
-	  return NULL;
-	}
+      generate_error (&dtp->common, ERROR_END, NULL);
+      return NULL;
+    }
 
-      dest = salloc_w (dtp->u.p.current_unit->s, &length);
+  if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
+    generate_error (&dtp->common, ERROR_END, NULL);
 
-      if (dest == NULL)
-	{
-	  generate_error (&dtp->common, ERROR_END, NULL);
-	  return NULL;
-	}
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    dtp->u.p.size_used += (gfc_offset) length;
 
-      dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
-    }
+  dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
 
   return dest;
 }
@@ -503,7 +476,16 @@ write_block (st_parameter_dt *dtp, int length)
 static try
 write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
 {
-  if (!is_stream_io (dtp))
+  if (is_stream_io (dtp))
+    {
+      if (sseek (dtp->u.p.current_unit->s,
+		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+	{
+	  generate_error (&dtp->common, ERROR_OS, NULL);
+	  return FAILURE;
+	}
+    }
+  else
     {
       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
 	{
@@ -526,15 +508,6 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
 
       dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
     }
-  else
-    {
-      if (sseek (dtp->u.p.current_unit->s,
-		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, ERROR_OS, NULL);
-	  return FAILURE;
-	}
-    }
 
   if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
     {
@@ -542,13 +515,10 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
       return FAILURE;
     }
 
-  if (!is_stream_io (dtp))
-    {
-      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
 	dtp->u.p.size_used += (gfc_offset) nbytes;
-    }
-  else
-    dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; 
+
+  dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; 
 
   return SUCCESS;
 }
@@ -2244,7 +2214,8 @@ next_record_w (st_parameter_dt *dtp, int done)
 		  else
 		    length = (int) dtp->u.p.current_unit->bytes_left;
 		}
-	      if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
+
+	if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
 		{
 		  generate_error (&dtp->common, ERROR_END, NULL);
 		  return;
@@ -2371,28 +2342,34 @@ finalize_transfer (st_parameter_dt *dtp)
     }
 
   if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
-    finish_list_read (dtp);
-  else if (!is_stream_io (dtp))
     {
-      dtp->u.p.current_unit->current_record = 0;
-      if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
-	{
-	  /* Most systems buffer lines, so force the partial record
-	     to be written out.  */
-	  if (!is_internal_unit (dtp))
-	    flush (dtp->u.p.current_unit->s);
-	  dtp->u.p.seen_dollar = 0;
-	  return;
-	}
-      next_record (dtp, 1);
+      finish_list_read (dtp);
+      sfree (dtp->u.p.current_unit->s);
+      return;
     }
-  else
+
+  if (is_stream_io (dtp))
     {
       if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
 	next_record (dtp, 1);
       flush (dtp->u.p.current_unit->s);
+      sfree (dtp->u.p.current_unit->s);
+      return;
+    }
+
+  dtp->u.p.current_unit->current_record = 0;
+
+  if (dtp->u.p.advance_status == ADVANCE_NO)
+    return;
+
+  if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar)
+    {
+      dtp->u.p.seen_dollar = 0;
+      sfree (dtp->u.p.current_unit->s);
+      return;
     }
 
+  next_record (dtp, 1);
   sfree (dtp->u.p.current_unit->s);
 }