2004-07-04 Bud Davis <bdavis9659@comcast.net>

            Paul Brook  <paul@codesourcery.com>

        PR fortran/15472
        * io/transfer.c(us_write): set recl for seq unform writes to max size.
        * io/transfer.c(data_transfer_init): handle un-opened seq unform unit.
        * io/unix.c(fd_alloc_w_at): handle requests at start, fd_flush at
          right time.
        * io/unix.c(is_seekable): set based upon the file/device, not the
          method being used to access it (fd or mmap).
        * io/unix.c(fd_flush): don't set file_size if !seekable.
        * io/unix.c(fd_truncate: ditto.
        * gfortran.fortran-torture/execute/seq_io.f90: New test.


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

3 files changed, 59 insertions, 18 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index ed0044d04e7..14a6349f023 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,16 @@
+2004-07-04  Bud Davis  <bdavis9659@comcast.net>
+	    Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/15472
+	* io/transfer.c(us_write): set recl for seq unform writes to max size.
+	* io/transfer.c(data_transfer_init): handle un-opened seq unform unit.
+	* io/unix.c(fd_alloc_w_at): handle requests at start, fd_flush at 
+	  right time.
+	* io/unix.c(is_seekable): set based upon the file/device, not the
+          method being used to access it (fd or mmap).
+	* io/unix.c(fd_flush): don't set file_size if !seekable.
+	* io/unix.c(fd_truncate: ditto.
+
 2004-07-04  Janne Blomqvist  <jblomqvi@cc.hut.fi>
 	Paul Brook  <paul@codesourcery.com>
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index b20f860bcef..ff4bc26f317 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -835,6 +835,11 @@ us_write (void)
   if (sfree (current_unit->s) == FAILURE)
     generate_error (ERROR_OS, NULL);
 
+  /* for sequential unformatted, we write until we have more bytes than
+      can fit in the record markers. if disk space runs out first it will
+      error on the write */
+  current_unit->recl = g.max_offset;
+
   current_unit->bytes_left = current_unit->recl;
 }
 
@@ -890,7 +895,11 @@ data_transfer_init (int read_flag)
      memset (&u_flags, '\0', sizeof (u_flags));
      u_flags.access = ACCESS_SEQUENTIAL;
      u_flags.action = ACTION_READWRITE;
-     u_flags.form = FORM_UNSPECIFIED;
+     /* is it unformatted ?*/
+     if (ioparm.format == NULL && !ioparm.list_format)
+       u_flags.form = FORM_UNFORMATTED;
+     else
+       u_flags.form = FORM_UNSPECIFIED;
      u_flags.delim = DELIM_UNSPECIFIED;
      u_flags.blank = BLANK_UNSPECIFIED;
      u_flags.pad = PAD_UNSPECIFIED;
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 0800447ba2e..0c652581c04 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -90,7 +90,7 @@ typedef struct
   gfc_offset physical_offset;	/* Current physical file offset */
   gfc_offset logical_offset;	/* Current logical file offset */
   gfc_offset dirty_offset;	/* Start of modified bytes in buffer */
-  gfc_offset file_length;		/* Length of the file, -1 if not seekable. */
+  gfc_offset file_length;	/* Length of the file, -1 if not seekable. */
 
   char *buffer;
   int len;			/* Physical length of the current buffer */
@@ -280,7 +280,9 @@ fd_flush (unix_stream * s)
     return FAILURE;
 
   s->physical_offset = s->dirty_offset + s->ndirty;
-  if (s->physical_offset > s->file_length)
+
+  /* don't increment file_length if the file is non-seekable */
+  if (s->file_length != -1 && s->physical_offset > s->file_length)
     s->file_length = s->physical_offset;
   s->ndirty = 0;
 
@@ -406,18 +408,28 @@ fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
     }
 
   /* Return a position within the current buffer */
-
-  if (s->ndirty == 0)
-    {				/* First write into a clean buffer */
-      s->dirty_offset = where;
-      s->ndirty = *len;
+  if (s->ndirty == 0 
+      || where > s->dirty_offset + s->ndirty    
+      || s->dirty_offset > where + *len)
+    {  /* Discontiguous blocks, start with a clean buffer.  */  
+        /* Flush the buffer.  */  
+       if (s->ndirty != 0)    
+         fd_flush (s);  
+       s->dirty_offset = where;  
+       s->ndirty = *len;
     }
   else
-    {
-      if (s->dirty_offset + s->ndirty == where)
-	s->ndirty += *len;
-      else
-	fd_flush (s);		/* Can't combine two dirty blocks */
+    {  
+      gfc_offset start;  /* Merge with the existing data.  */  
+      if (where < s->dirty_offset)    
+        start = where;  
+      else    
+        start = s->dirty_offset;  
+      if (where + *len > s->dirty_offset + s->ndirty)    
+        s->ndirty = where + *len - start;  
+      else    
+        s->ndirty = s->dirty_offset + s->ndirty - start;  
+        s->dirty_offset = start;
     }
 
   s->logical_offset = where + *len;
@@ -461,13 +473,18 @@ static try
 fd_truncate (unix_stream * s)
 {
 
-  if (ftruncate (s->fd, s->logical_offset))
+  if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
     return FAILURE;
 
-  s->physical_offset = s->file_length = s->logical_offset;
+  /* non-seekable files, like terminals and fifo's fail the lseek.
+     the fd is a regular file at this point */
 
-  if (lseek (s->fd, s->file_length, SEEK_SET) == -1)
+  if (ftruncate (s->fd, s->logical_offset))
+   {
     return FAILURE;
+   }
+
+  s->physical_offset = s->file_length = s->logical_offset;
 
   return SUCCESS;
 }
@@ -1390,8 +1407,10 @@ file_position (stream * s)
 int
 is_seekable (stream * s)
 {
-
-  return ((unix_stream *) s)->mmaped;
+  /* by convention, if file_length == -1, the file is not seekable
+     note that a mmapped file is always seekable, an fd_ file may
+     or may not be. */
+  return ((unix_stream *) s)->file_length!=-1;
 }
 
 try