[Guile-commits] 13/18: Flush buffered reads / writes before seeking

[Andy Wingo]

wingo pushed a commit to branch wip-port-refactor
in repository guile.

commit b77fb752dd7e14876741ecb6360ef0319eae18e0
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 4 11:28:28 2016 +0200

    Flush buffered reads / writes before seeking
    
    * libguile/ports.c (scm_seek): Flush before seeking on a buffered port.
    * libguile/fports.c (fport_seek):
    * libguile/strports.c (st_seek): Remove code to flush buffers.
    * test-suite/tests/ports.test: Update test expectations that the
      putback buffer is flushed on a seek.  Previously there was a special
      case for SEEK_CUR with an offset of 0 to avoid flushing buffers, but
      that's an arbitrary choice that differs from all other combinations of
      OFFSET and WHENCE.
---
 libguile/fports.c           |   42 +-------------------
 libguile/ports.c            |   16 ++++++-
 libguile/strports.c         |   88 ++++++++++++++++--------------------------
 test-suite/tests/ports.test |    8 ++--
 4 files changed, 53 insertions(+), 101 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 2b415b9..e33bfe5 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -670,50 +670,12 @@ fport_fill_input (SCM port)
 static scm_t_off
 fport_seek (SCM port, scm_t_off offset, int whence)
 {
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   scm_t_fport *fp = SCM_FSTREAM (port);
-  off_t_or_off64_t rv;
   off_t_or_off64_t result;
 
-  if (pt->rw_active == SCM_PORT_WRITE)
-    {
-      if (offset != 0 || whence != SEEK_CUR)
-       {
-         fport_flush (port);
-         result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
-       }
-      else
-       {
-         /* read current position without disturbing the buffer.  */
-         rv = lseek_or_lseek64 (fp->fdes, offset, whence);
-         result = rv + (pt->write_pos - pt->write_buf);
-       }
-    }
-  else if (pt->rw_active == SCM_PORT_READ)
-    {
-      if (offset != 0 || whence != SEEK_CUR)
-       {
-         /* could expand to avoid a second seek.  */
-         scm_end_input_unlocked (port);
-         result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
-       }
-      else
-       {
-         /* read current position without disturbing the buffer
-            (particularly the unread-char buffer).  */
-         rv = lseek_or_lseek64 (fp->fdes, offset, whence);
-         result = rv - (pt->read_end - pt->read_pos);
-
-         if (pt->read_buf == pt->putback_buf)
-           result -= pt->saved_read_end - pt->saved_read_pos;
-       }
-    }
-  else /* SCM_PORT_NEITHER */
-    {
-      result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
-    }
+  result = lseek_or_lseek64 (fp->fdes, offset, whence);
 
-  if (rv == -1)
+  if (result == -1)
     scm_syserror ("fport_seek");
 
   return result;
diff --git a/libguile/ports.c b/libguile/ports.c
index e51ac5e..202f7f9 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2851,16 +2851,26 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
 
   if (SCM_OPPORTP (fd_port))
     {
+      scm_t_port *pt = SCM_PTAB_ENTRY (fd_port);
       scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (fd_port);
       scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (fd_port);
       off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
       off_t_or_off64_t rv;
 
-      if (!ptob->seek)
+      if (!ptob->seek || !pt->rw_random)
        SCM_MISC_ERROR ("port is not seekable", 
                         scm_cons (fd_port, SCM_EOL));
-      else
-        rv = ptob->seek (fd_port, off, how);
+
+      /* FIXME: Avoid flushing buffers for SEEK_CUR with an offset of
+         0.  */
+
+      if (pt->rw_active == SCM_PORT_READ)
+        scm_end_input_unlocked (pt->port);
+      else if (pt->rw_active == SCM_PORT_WRITE)
+        scm_flush_unlocked (pt->port);
+      pt->rw_active = SCM_PORT_NEITHER;
+
+      rv = ptob->seek (fd_port, off, how);
 
       /* Set stream-start flags according to new position. */
       pti->at_stream_start_for_bom_read  = (rv == 0);
diff --git a/libguile/strports.c b/libguile/strports.c
index 6c65ec8..064e2f0 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -162,64 +162,44 @@ st_seek (SCM port, scm_t_off offset, int whence)
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   scm_t_off target;
 
-  if (pt->rw_active == SCM_PORT_READ && offset == 0 && whence == SEEK_CUR)
-    /* special case to avoid disturbing the unread-char buffer.  */
+  switch (whence)
     {
-      if (pt->read_buf == pt->putback_buf)
-       {
-         target = pt->saved_read_pos - pt->saved_read_buf
-           - (pt->read_end - pt->read_pos);
-       }
-      else
-       {
-         target = pt->read_pos - pt->read_buf;
-       }
+    case SEEK_CUR:
+      target = pt->read_pos - pt->read_buf + offset;
+      break;
+    case SEEK_END:
+      target = pt->read_end - pt->read_buf + offset;
+      break;
+    default: /* SEEK_SET */
+      target = offset;
+      break;
     }
-  else
-    /* all other cases.  */
-    {
-      if (pt->rw_active == SCM_PORT_READ)
-       scm_end_input_unlocked (port);
-
-      pt->rw_active = SCM_PORT_NEITHER;
-
-      switch (whence)
-       {
-       case SEEK_CUR:
-         target = pt->read_pos - pt->read_buf + offset;
-         break;
-       case SEEK_END:
-         target = pt->read_end - pt->read_buf + offset;
-         break;
-       default: /* SEEK_SET */
-         target = offset;
-         break;
-       }
-
-      if (target < 0)
-       scm_misc_error ("st_seek", "negative offset", SCM_EOL);
+
+  if (target < 0)
+    scm_misc_error ("st_seek", "negative offset", SCM_EOL);
   
-      if (target >= pt->write_buf_size)
-       {
-         if (!(SCM_CELL_WORD_0 (port) & SCM_WRTNG))
-           {
-             if (target > pt->write_buf_size)
-               {
-                 scm_misc_error ("st_seek", 
-                                 "seek past end of read-only strport",
-                                 SCM_EOL);
-               }
-           }
-         else if (target == pt->write_buf_size)
-           st_resize_port (pt, target * 2);
-       }
-      pt->read_pos = pt->write_pos = pt->read_buf + target;
-      if (pt->read_pos > pt->read_end)
-       {
-         pt->read_end = (unsigned char *) pt->read_pos;
-         pt->read_buf_size = pt->read_end - pt->read_buf;
-       }
+  if (target >= pt->write_buf_size)
+    {
+      if (!(SCM_CELL_WORD_0 (port) & SCM_WRTNG))
+        {
+          if (target > pt->write_buf_size)
+            {
+              scm_misc_error ("st_seek", 
+                              "seek past end of read-only strport",
+                              SCM_EOL);
+            }
+        }
+      else if (target == pt->write_buf_size)
+        st_resize_port (pt, target * 2);
+    }
+
+  pt->read_pos = pt->write_pos = pt->read_buf + target;
+  if (pt->read_pos > pt->read_end)
+    {
+      pt->read_end = (unsigned char *) pt->read_pos;
+      pt->read_buf_size = pt->read_end - pt->read_buf;
     }
+
   return target;
 }
 
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 2bc719e..33050fd 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -176,8 +176,8 @@
     (unread-char #\z iport)
     (pass-if "file: in tell 0 after unread"
              (= (seek iport 0 SEEK_CUR) 0))
-    (pass-if "file: unread char still there"
-             (char=? (read-char iport) #\z))
+    (pass-if "file: putback buffer flushed after seek"
+             (char=? (read-char iport) #\J))
     (seek iport 7 SEEK_SET)
     (pass-if "file: in last char"
              (char=? (read-char iport) #\x))
@@ -700,8 +700,8 @@
                               (unread-char #\x p)
                               (pass-if "input tell back to 0"
                                        (= (seek p 0 SEEK_CUR) 0))
-                              (pass-if "input ungetted char"
-                                       (char=? (read-char p) #\x))
+                              (pass-if "putback buffer discarded after seek"
+                                       (char=? (read-char p) #\t))
                               (seek p 0 SEEK_END)
                               (pass-if "input seek to end"
                                        (= (seek p 0 SEEK_CUR)