mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +02:00
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.
This commit is contained in:
parent
0eba699d12
commit
e8b21eecb1
3 changed files with 55 additions and 14 deletions
|
@ -1,5 +1,5 @@
|
||||||
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
/* 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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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;
|
int cmode;
|
||||||
long csize;
|
long csize;
|
||||||
SCM drained;
|
size_t ndrained;
|
||||||
|
char *drained;
|
||||||
scm_t_port *pt;
|
scm_t_port *pt;
|
||||||
|
|
||||||
port = SCM_COERCE_OUTPORT (port);
|
port = SCM_COERCE_OUTPORT (port);
|
||||||
|
@ -211,9 +212,21 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
|
||||||
pt = SCM_PTAB_ENTRY (port);
|
pt = SCM_PTAB_ENTRY (port);
|
||||||
|
|
||||||
if (SCM_INPUT_PORT_P (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
|
else
|
||||||
drained = scm_nullstr;
|
ndrained = 0;
|
||||||
|
|
||||||
if (SCM_OUTPUT_PORT_P (port))
|
if (SCM_OUTPUT_PORT_P (port))
|
||||||
scm_flush (port);
|
scm_flush (port);
|
||||||
|
@ -232,8 +245,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
|
||||||
|
|
||||||
scm_fport_buffer_add (port, csize, csize);
|
scm_fport_buffer_add (port, csize, csize);
|
||||||
|
|
||||||
if (scm_is_true (drained) && scm_c_string_length (drained))
|
if (ndrained > 0)
|
||||||
scm_unread_string (drained, port);
|
/* Put DRAINED back to PORT. */
|
||||||
|
while (ndrained-- > 0)
|
||||||
|
scm_unget_byte (drained[ndrained], port);
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
|
|
@ -289,19 +289,21 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
/* move up to read_len chars from port's putback and/or read buffers
|
/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
|
||||||
into memory starting at dest. returns the number of chars moved. */
|
into memory starting at DEST. Return the number of bytes moved.
|
||||||
size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
|
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);
|
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);
|
size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
|
||||||
|
|
||||||
if (from_buf > 0)
|
if (from_buf > 0)
|
||||||
{
|
{
|
||||||
memcpy (dest, pt->read_pos, from_buf);
|
memcpy (dest, pt->read_pos, from_buf);
|
||||||
pt->read_pos += from_buf;
|
pt->read_pos += from_buf;
|
||||||
chars_read += from_buf;
|
bytes_read += from_buf;
|
||||||
read_len -= from_buf;
|
read_len -= from_buf;
|
||||||
dest += 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);
|
memcpy (dest, pt->saved_read_pos, from_buf);
|
||||||
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. */
|
/* Clear a port's read buffers, returning the contents. */
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
|
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
|
;;;; 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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -1064,6 +1064,29 @@
|
||||||
(list read read-char read-line)
|
(list read read-char read-line)
|
||||||
'("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))
|
(delete-file (test-file))
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue