[Guile-commits] 01/02: Avoid flushing buffers for ftell

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit eeb23e776abc7ec4ae6c71cf4d53814e38695d8e
Author: Andy Wingo <address@hidden>
Date:   Wed Aug 31 15:39:01 2016 +0200

    Avoid flushing buffers for ftell
    
    * libguile/ports.c (scm_seek): Avoid flushing buffers for an ftell.
      Also allows non-random-access ports to ftell() if they have a seek
      implementation, as is the case for custom binary ports with a
      get-position function but no set-position function.
    * test-suite/tests/ports.test: Adapt expectations, reverting changes
      made in April by me in b77fb752dd7e14876741ecb6360ef0319eae18e0.
---
 libguile/ports.c            |   14 +++++++++++---
 test-suite/tests/ports.test |    8 ++++----
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/libguile/ports.c b/libguile/ports.c
index 434e48e..9e5211f 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -3544,13 +3544,21 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
       off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
       off_t_or_off64_t rv;
 
+      if (ptob->seek && how == SEEK_CUR && off == 0)
+        {
+          /* If we are just querying the current position, avoid
+             flushing buffers.  We don't even need to require that the
+             port supports random access.  */
+          rv = ptob->seek (fd_port, off, how);
+          rv -= scm_port_buffer_can_take (pt->read_buf);
+          rv += scm_port_buffer_can_take (pt->write_buf);
+          return scm_from_off_t_or_off64_t (rv);
+        }
+
       if (!ptob->seek || !pt->rw_random)
        SCM_MISC_ERROR ("port is not seekable", 
                         scm_cons (fd_port, SCM_EOL));
 
-      /* FIXME: Avoid flushing buffers for SEEK_CUR with an offset of
-         0.  */
-
       scm_end_input (fd_port);
       scm_flush (fd_port);
 
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index ea8eaa7..86165fd 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -177,8 +177,8 @@
     (unread-char #\z iport)
     (pass-if "file: in tell 0 after unread"
              (= (seek iport 0 SEEK_CUR) 0))
-    (pass-if "file: putback buffer flushed after seek"
-             (char=? (read-char iport) #\J))
+    (pass-if "file: unread char still there"
+             (char=? (read-char iport) #\z))
     (seek iport 7 SEEK_SET)
     (pass-if "file: in last char"
              (char=? (read-char iport) #\x))
@@ -699,8 +699,8 @@
                               (unread-char #\x p)
                               (pass-if "input tell back to 0"
                                        (= (seek p 0 SEEK_CUR) 0))
-                              (pass-if "putback buffer discarded after seek"
-                                       (char=? (read-char p) #\t))
+                              (pass-if "input ungetted char"
+                                       (char=? (read-char p) #\x))
                               (seek p 0 SEEK_END)
                               (pass-if "input seek to end"
                                        (= (seek p 0 SEEK_CUR)