Fix `setvbuf' to leave the line/column number unchanged.

* libguile/fports.c (scm_setvbuf): Use `scm_take_from_input_buffers'
  directly instead of `scm_drain_input'; use `scm_unget_byte' instead of
  `scm_unread_string' to put the drained input back to PORT.  This
  leaves PORT's line/column numbers unchanged, whereas they'd previously
  be decreased by the `scm_unread_string' call.

* libguile/ports.c (scm_take_from_input_buffers): Update description and
  variable names to refer to "bytes", not "chars".

* test-suite/tests/ports.test ("setvbuf"): New test prefix.

diff --git a/libguile/fports.c b/libguile/fports.c
index 3ac3ced..10cf671 100644 (file)
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+ *   2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -174,7 +174,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 {
   int cmode;
   long csize;
-  SCM drained;
+  size_t ndrained;
+  char *drained;
   scm_t_port *pt;
 
   port = SCM_COERCE_OUTPORT (port);
@@ -211,9 +212,21 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
   pt = SCM_PTAB_ENTRY (port);
 
   if (SCM_INPUT_PORT_P (port))
-    drained = scm_drain_input (port);
+    {
+      /* Drain pending input from PORT.  Don't use `scm_drain_input' since
+        it returns a string, whereas we want binary input here.  */
+      ndrained = pt->read_end - pt->read_pos;
+      if (pt->read_buf == pt->putback_buf)
+       ndrained += pt->saved_read_end - pt->saved_read_pos;
+
+      if (ndrained > 0)
+       {
+         drained = scm_gc_malloc_pointerless (ndrained, "file port");
+         scm_take_from_input_buffers (port, drained, ndrained);
+       }
+    }
   else
-    drained = scm_nullstr;
+    ndrained = 0;
 
   if (SCM_OUTPUT_PORT_P (port))
     scm_flush (port);
@@ -232,8 +245,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   scm_fport_buffer_add (port, csize, csize);
 
-  if (scm_is_true (drained) && scm_c_string_length (drained))
-    scm_unread_string (drained, port);
+  if (ndrained > 0)
+    /* Put DRAINED back to PORT.  */
+    while (ndrained-- > 0)
+      scm_unget_byte (drained[ndrained], port);
 
   return SCM_UNSPECIFIED;
 }

diff --git a/libguile/ports.c b/libguile/ports.c
index 2d8b9ed..3ef92b9 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -289,19 +289,21 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
 }
 #undef FUNC_NAME
 
-/* move up to read_len chars from port's putback and/or read buffers
-   into memory starting at dest.  returns the number of chars moved.  */
-size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
+/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
+   into memory starting at DEST.  Return the number of bytes moved.
+   PORT's line/column numbers are left unchanged.  */
+size_t
+scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  size_t chars_read = 0;
+  size_t bytes_read = 0;
   size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
 
   if (from_buf > 0)
     {
       memcpy (dest, pt->read_pos, from_buf);
       pt->read_pos += from_buf;
-      chars_read += from_buf;
+      bytes_read += from_buf;
       read_len -= from_buf;
       dest += from_buf;
     }
@@ -314,10 +316,11 @@ size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
        {
          memcpy (dest, pt->saved_read_pos, from_buf);
          pt->saved_read_pos += from_buf;
-         chars_read += from_buf;
+         bytes_read += from_buf;
        }
     }
-  return chars_read;
+
+  return bytes_read;
 }
 
 /* Clear a port's read buffers, returning the contents.  */

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index d4a333f..5ca416d 100644 (file)
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;;      2011 Free Software Foundation, Inc.
+;;;;      2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1064,6 +1064,29 @@
            (list read read-char read-line)
            '("read" "read-char" "read-line")))
 
+\f
+
+(with-test-prefix "setvbuf"
+
+  (pass-if "line/column number preserved"
+    ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
+    ;; line and/or column number.
+    (call-with-output-file (test-file)
+      (lambda (p)
+        (display "This is GNU Guile.\nWelcome." p)))
+    (call-with-input-file (test-file)
+      (lambda (p)
+        (and (eq? #\T (read-char p))
+             (let ((line (port-line p))
+                   (col  (port-column p)))
+               (and (= line 0) (= col 1)
+                    (begin
+                      (setvbuf p _IOFBF 777)
+                      (let ((line* (port-line p))
+                            (col*  (port-column p)))
+                        (and (= line line*)
+                             (= col col*)))))))))))
+
 (delete-file (test-file))
 
 ;;; Local Variables: