mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

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

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-05-08 12:43:06 +02:00
parent 0eba699d12
commit e8b21eecb1
3 changed files with 55 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/fports.c
View file

@ -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;
}

17
libguile/ports.c
View file

@ -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. */

25
test-suite/tests/ports.test
View file

@ -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")))
(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: