mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Use symbols instead of _IONBF values as args to setvbuf

Browse source 
* libguile/ports.c (scm_setvbuf): Use the symbols `none', `line', and
  `block' instead of the values `_IONBF', `_IOLBF', and `_IOFBF'.
* NEWS: Update.
* doc/ref/posix.texi (Ports and File Descriptors): Update setvbuf
documentation.
* module/ice-9/deprecated.scm (define-deprecated): New helper.
(_IONBF, _IOLBF, _IOFBF): Define deprecated values.
* benchmark-suite/benchmarks/read.bm ("read"):
* benchmark-suite/benchmarks/uniform-vector-read.bm
("uniform-vector-read!"):
* libguile/r6rs-ports.c (cbip_fill_input):
* module/system/base/types.scm (%ffi-memory-backend):
* module/web/client.scm (open-socket-for-uri):
* module/web/server/http.scm (http-read):
* test-suite/tests/ports.test ("pipe, fdopen, and line buffering"):
("setvbuf"):
* test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports"): Update to use
non-deprecated interfaces.
This commit is contained in:
Andy Wingo 2016-04-02 11:50:46 +02:00
parent 0a0a8d819d
commit 59a18451b8
12 changed files with 103 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

16
NEWS
View file

@ -5,6 +5,22 @@ See the end for copying conditions.
Please send Guile bug reports to bug-guile@gnu.org.
FIXME: Incorporate 2.1.2 changes into cumulative 2.2 changes before
releasing 2.1.3.
Changes in 2.1.3 (changes since the 2.1.2 alpha release):
* Notable changes
* New deprecations
** `_IONBF', `_IOLBF', and `_IOFBF'
Instead, use the symbol values `none', `line', or `block', respectively,
as arguments to the `setvbuf' function.
* Incompatible changes
Changes in 2.1.2 (changes since the 2.1.1 alpha release):

20
benchmark-suite/benchmarks/read.bm
View file

@ -51,20 +51,20 @@
(with-benchmark-prefix "read"
(benchmark "_IONBF" 5 ;; this one is very slow
(exercise-read (list _IONBF)))
(benchmark "'none" 5 ;; this one is very slow
(exercise-read (list 'none)))
(benchmark "_IOLBF" 10
(exercise-read (list _IOLBF)))
(benchmark "'line" 10
(exercise-read (list 'line)))
(benchmark "_IOFBF 4096" 10
(exercise-read (list _IOFBF 4096)))
(benchmark "'block 4096" 10
(exercise-read (list 'block 4096)))
(benchmark "_IOFBF 8192" 10
(exercise-read (list _IOFBF 8192)))
(benchmark "'block 8192" 10
(exercise-read (list 'block 8192)))
(benchmark "_IOFBF 16384" 10
(exercise-read (list _IOFBF 16384)))
(benchmark "'block 16384" 10
(exercise-read (list 'block 16384)))
(benchmark "small strings" 100000
(call-with-input-string small read))

2
benchmark-suite/benchmarks/uniform-vector-read.bm
View file

@ -43,7 +43,7 @@
(benchmark "uniform-vector-read!" 20000
(let ((input (open-input-file file-name)))
(setvbuf input _IONBF)
(setvbuf input 'none)
(uniform-vector-read! buf input)
(close input)))

14
doc/ref/posix.texi
View file

@ -458,18 +458,18 @@ cookie.
@deffn {Scheme Procedure} setvbuf port mode [size]
@deffnx {C Function} scm_setvbuf (port, mode, size)
@cindex port buffering
Set the buffering mode for @var{port}. @var{mode} can be:
Set the buffering mode for @var{port}. @var{mode} can be one of the
following symbols:
@defvar _IONBF
@table @code
@item none
non-buffered
@end defvar
@defvar _IOLBF
@item line
line buffered
@end defvar
@defvar _IOFBF
@item block
block buffered, using a newly allocated buffer of @var{size} bytes.
If @var{size} is omitted, a default size will be used.
@end defvar
@end table
Only certain types of ports are supported, most importantly
file ports.

70
libguile/ports.c
View file

@ -2337,65 +2337,67 @@ scm_port_non_buffer (scm_t_port *pt)
pt->write_end = pt->write_buf + pt->write_buf_size;
}
SCM_SYMBOL (sym_none, "none");
SCM_SYMBOL (sym_line, "line");
SCM_SYMBOL (sym_block, "block");
SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
(SCM port, SCM mode, SCM size),
"Set the buffering mode for @var{port}. @var{mode} can be:\n"
"Set the buffering mode for @var{port}. @var{mode} can be one\n"
"of the following symbols:\n"
"@table @code\n"
"@item _IONBF\n"
"non-buffered\n"
"@item _IOLBF\n"
"line buffered\n"
"@item _IOFBF\n"
"block buffered, using a newly allocated buffer of @var{size} bytes.\n"
"@item none\n"
"no buffering\n"
"@item line\n"
"line buffering\n"
"@item block\n"
"block buffering, using a newly allocated buffer of @var{size} bytes.\n"
"If @var{size} is omitted, a default size will be used.\n"
"@end table\n\n"
"Only certain types of ports are supported, most importantly\n"
"file ports.")
#define FUNC_NAME s_scm_setvbuf
{
int cmode;
long csize;
size_t ndrained;
char *drained = NULL;
scm_t_port *pt;
scm_t_ptob_descriptor *ptob;
scm_t_bits tag_word;
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
ptob = SCM_PORT_DESCRIPTOR (port);
tag_word = SCM_CELL_WORD_0 (port) & ~(SCM_BUF0 | SCM_BUFLINE);
if (ptob->setvbuf == NULL)
scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
"port that supports 'setvbuf'");
cmode = scm_to_int (mode);
if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
if (scm_is_eq (mode, sym_none))
{
tag_word |= SCM_BUF0;
if (!SCM_UNBNDP (size) && !scm_is_eq (size, SCM_INUM0))
scm_out_of_range (FUNC_NAME, size);
csize = 0;
}
else if (scm_is_eq (mode, sym_line))
{
csize = SCM_UNBNDP (size) ? -1 : scm_to_int (size);
tag_word |= SCM_BUFLINE;
}
else if (scm_is_eq (mode, sym_block))
{
csize = SCM_UNBNDP (size) ? -1 : scm_to_int (size);
}
else
scm_out_of_range (FUNC_NAME, mode);
if (cmode == _IOLBF)
{
SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
cmode = _IOFBF;
}
else
SCM_SET_CELL_WORD_0 (port,
SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
if (SCM_UNBNDP (size))
{
if (cmode == _IOFBF)
csize = -1;
else
csize = 0;
}
else
{
csize = scm_to_int (size);
if (csize < 0 || (cmode == _IONBF && csize > 0))
scm_out_of_range (FUNC_NAME, size);
}
if (!SCM_UNBNDP (size) && csize < 0)
scm_out_of_range (FUNC_NAME, size);
SCM_SET_CELL_WORD_0 (port, tag_word);
pt = SCM_PTAB_ENTRY (port);
if (SCM_INPUT_PORT_P (port))
@ -3282,10 +3284,6 @@ scm_init_ports ()
scm_c_define ("SEEK_CUR", scm_from_int (SEEK_CUR));
scm_c_define ("SEEK_END", scm_from_int (SEEK_END));
scm_c_define ("_IOFBF", scm_from_int (_IOFBF));
scm_c_define ("_IOLBF", scm_from_int (_IOLBF));
scm_c_define ("_IONBF", scm_from_int (_IONBF));
scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port,
write_void_port);

2
libguile/r6rs-ports.c
View file

@ -387,7 +387,7 @@ cbip_fill_input (SCM port)
if (buffered)
{
/* Make sure the buffer isn't corrupt. Its size can be 1 when
someone called 'setvbuf' with _IONBF. BV can be passed
someone called 'setvbuf' with 'none. BV can be passed
directly to READ_PROC. */
assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv)
|| c_port->read_buf_size == 1);

19
module/ice-9/deprecated.scm
View file

@ -16,4 +16,21 @@
;;;;
(define-module (ice-9 deprecated)
#:export ())
#:export (_IONBF _IOLBF _IOFBF))
(define-syntax-rule (define-deprecated var msg exp)
(define-syntax var
(lambda (x)
(issue-deprecation-warning msg)
(syntax-case x ()
(id (identifier? #'id) #'exp)))))
(define-deprecated _IONBF
"`_IONBF' is deprecated. Use the symbol 'none instead."
'none)
(define-deprecated _IOLBF
"`_IOLBF' is deprecated. Use the symbol 'line instead."
'line)
(define-deprecated _IOFBF
"`_IOFBF' is deprecated. Use the symbol 'block instead."
'block)

2
module/system/base/types.scm
View file

@ -99,7 +99,7 @@
(let ((port (make-custom-binary-input-port "ffi-memory"
read-memory!
#f #f #f)))
(setvbuf port _IONBF)
(setvbuf port 'none)
port)))
(memory-backend dereference-word open #f)))

2
module/web/client.scm
View file

@ -92,7 +92,7 @@
(connect s (addrinfo:addr ai))
;; Buffer input and output on this port.
(setvbuf s _IOFBF)
(setvbuf s 'block)
;; If we're using a proxy, make a note of that.
(when http-proxy (set-http-proxy-port?! s #t))
s)

2
module/web/server/http.scm
View file

@ -97,7 +97,7 @@
;; FIXME: preserve meta-info.
(let ((client (accept (poll-set-port poll-set idx))))
;; Buffer input and output on this port.
(setvbuf (car client) _IOFBF)
(setvbuf (car client) 'block)
;; From "HOP, A Fast Server for the Diffuse Web", Serrano.
(setsockopt (car client) SOL_SOCKET SO_SNDBUF (* 12 1024))
(poll-set-add! poll-set (car client) *events*)

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

@ -637,7 +637,7 @@
(equal? in-string "Mommy, why does everybody have a bomb?\n")))
(delete-file filename))
(pass-if-equal "pipe, fdopen, and _IOLBF"
(pass-if-equal "pipe, fdopen, and line buffering"
"foo\nbar\n"
(let ((in+out (pipe))
(pid (primitive-fork)))
@ -647,7 +647,7 @@
(lambda ()
(close-port (car in+out))
(let ((port (cdr in+out)))
(setvbuf port _IOLBF )
(setvbuf port 'line )
;; Strings containing '\n' or should be flushed; others
;; should be kept in PORT's buffer.
(display "foo\n" port)
@ -1519,13 +1519,13 @@
exception:wrong-type-arg
(let ((port (open-input-file "/dev/null")))
(close-port port)
(setvbuf port _IOFBF)))
(setvbuf port 'block)))
(pass-if-exception "string port"
exception:wrong-type-arg
(let ((port (open-input-string "Hey!")))
(close-port port)
(setvbuf port _IOFBF)))
(setvbuf port 'block)))
(pass-if "line/column number preserved"
;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
@ -1540,7 +1540,7 @@
(col (port-column p)))
(and (= line 0) (= col 1)
(begin
(setvbuf p _IOFBF 777)
(setvbuf p 'block 777)
(let ((line* (port-line p))
(col* (port-column p)))
(and (= line line*)

16
test-suite/tests/r6rs-ports.test
View file

@ -516,7 +516,7 @@ not `set-port-position!'"
p)))
(port (make-custom-binary-input-port "the port" read!
get-pos #f #f)))
(setvbuf port _IONBF)
(setvbuf port 'none)
(and (= 0 (port-position port))
(begin
(get-bytevector-n! port output 0 2)
@ -545,7 +545,7 @@ not `set-port-position!'"
(port (make-custom-binary-input-port "the port" read!
#f #f #f)))
(setvbuf port _IONBF)
(setvbuf port 'none)
(let ((ret (list (get-bytevector-n port 2)
(get-bytevector-n port 3)
(get-bytevector-n port 42))))
@ -568,7 +568,7 @@ not `set-port-position!'"
(if (eof-object? n) 0 n))))
(port (make-custom-binary-input-port "foo" read!
#f #f #f)))
(setvbuf port _IONBF)
(setvbuf port 'none)
(get-string-all port)))
(pass-if-equal "custom binary input port unbuffered UTF-8 & 'get-string-all'"
@ -583,7 +583,7 @@ not `set-port-position!'"
(if (eof-object? n) 0 n))))
(port (make-custom-binary-input-port "foo" read!
#f #f #f)))
(setvbuf port _IONBF)
(setvbuf port 'none)
(set-port-encoding! port "UTF-8")
(get-string-all port)))
@ -603,11 +603,11 @@ not `set-port-position!'"
(port (make-custom-binary-input-port "the port" read!
#f #f #f)))
(setvbuf port _IONBF)
(setvbuf port 'none)
(let ((ret (list (get-bytevector-n port 6)
(get-bytevector-n port 12)
(begin
(setvbuf port _IOFBF 777)
(setvbuf port 'block 777)
(get-bytevector-n port 42))
(get-bytevector-n port 42))))
(zip (reverse reads)
@ -635,11 +635,11 @@ not `set-port-position!'"
(port (make-custom-binary-input-port "the port" read!
#f #f #f)))
(setvbuf port _IOFBF 18)
(setvbuf port 'block 18)
(let ((ret (list (get-bytevector-n port 6)
(get-bytevector-n port 12)
(begin
(setvbuf port _IONBF)
(setvbuf port 'none)
(get-bytevector-n port 42))
(get-bytevector-n port 42))))
(list (reverse reads)