re PR libfortran/25545 (internal file and dollar edit descriptor)

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.

From-SVN: r118506

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8b5eddff4ec221afbe57dbb8273815087712b3a5..88d76c81ab04a7eb85544a3e54ea739b406210f0 100644 (file)
--- 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 b4c2bb65b0c1be0616efe47eb6df80d5a533e9af..a4d456389b164bb0ca01efc477f317f586d6cde9 100644 (file)
--- 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);
 }