Simplify handling of special files.

[pf3gnuchains/gcc-fork.git] / libgfortran / io / unit.c

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index bbe1120..d2fb6d0 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -423,9 +423,16 @@ get_internal_unit (st_parameter_dt *dtp)
     }
 
   /* Set initial values for unit parameters.  */
+  if (dtp->common.unit)
+    {
+      iunit->s = open_internal4 (dtp->internal_unit - start_record,
+                                dtp->internal_unit_len, -start_record);
+      fbuf_init (iunit, 256);
+    }
+  else
+    iunit->s = open_internal (dtp->internal_unit - start_record,
+                             dtp->internal_unit_len, -start_record);
 
-  iunit->s = open_internal (dtp->internal_unit - start_record,
-                           dtp->internal_unit_len, -start_record);
   iunit->bytes_left = iunit->recl;
   iunit->last_record=0;
   iunit->maxrec=0;
@@ -471,13 +478,14 @@ free_internal_unit (st_parameter_dt *dtp)
   if (!is_internal_unit (dtp))
     return;
 
+  if (unlikely (is_char4_unit (dtp)))
+    fbuf_destroy (dtp->u.p.current_unit);
+
   if (dtp->u.p.current_unit != NULL)
     {
-      if (dtp->u.p.current_unit->ls != NULL)
-       free (dtp->u.p.current_unit->ls);
+      free (dtp->u.p.current_unit->ls);
   
-      if (dtp->u.p.current_unit->s)
-       free (dtp->u.p.current_unit->s);
+      free (dtp->u.p.current_unit->s);
   
       destroy_unit_mutex (dtp->u.p.current_unit);
     }
@@ -493,7 +501,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
 {
 
   if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
-    return get_internal_unit(dtp);
+    return get_internal_unit (dtp);
 
   /* Has to be an external unit.  */
 
@@ -642,8 +650,7 @@ close_unit_1 (gfc_unit *u, int locked)
 
   delete_unit (u);
 
-  if (u->file)
-    free (u->file);
+  free (u->file);
   u->file = NULL;
   u->file_len = 0;
 
@@ -704,19 +711,24 @@ close_units (void)
 void
 update_position (gfc_unit *u)
 {
-  if (stell (u->s) == 0)
+  /* If unit is not seekable, this makes no sense (and the standard is
+     silent on this matter), and thus we don't change the position for
+     a non-seekable file.  */
+  gfc_offset cur = stell (u->s);
+  if (cur == -1)
+    return;
+  else if (cur == 0)
     u->flags.position = POSITION_REWIND;
-  else if (file_length (u->s) == stell (u->s))
+  else if (file_length (u->s) == cur)
     u->flags.position = POSITION_APPEND;
   else
     u->flags.position = POSITION_ASIS;
 }
 
 
-/* High level interface to truncate a file safely, i.e. flush format
-   buffers, check that it's a regular file, and generate error if that
-   occurs.  Just like POSIX ftruncate, returns 0 on success, -1 on
-   failure.  */
+/* High level interface to truncate a file, i.e. flush format buffers,
+   and generate an error or set some flags.  Just like POSIX
+   ftruncate, returns 0 on success, -1 on failure.  */
 
 int
 unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
@@ -732,24 +744,12 @@ unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
        fbuf_flush (u, u->mode);
     }
   
-  /* Don't try to truncate a special file, just pretend that it
-     succeeds.  */
-  if (is_special (u->s) || !is_seekable (u->s))
-    {
-      sflush (u->s);
-      return 0;
-    }
-
   /* struncate() should flush the stream buffer if necessary, so don't
      bother calling sflush() here.  */
   ret = struncate (u->s, pos);
 
   if (ret != 0)
-    {
-      generate_error (common, LIBERROR_OS, NULL);
-      u->endfile = NO_ENDFILE;
-      u->flags.position = POSITION_ASIS;
-    }
+    generate_error (common, LIBERROR_OS, NULL);
   else
     {
       u->endfile = AT_ENDFILE;