summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-04-02 11:50:46 +0200
committerAndy Wingo <wingo@pobox.com>2016-04-04 16:30:56 +0200
commit59a18451b8bc70fe9cb9b9f41e61bbfa9e0e86be (patch)
treee4665183a3a144d60bb563e0f61260ff94393c1a
parent0a0a8d819db685e240f0a27404ffd167654b7f85 (diff)
Use symbols instead of _IONBF values as args to setvbuf
* 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.
-rw-r--r--NEWS16
-rw-r--r--benchmark-suite/benchmarks/read.bm20
-rw-r--r--benchmark-suite/benchmarks/uniform-vector-read.bm2
-rw-r--r--doc/ref/posix.texi14
-rw-r--r--libguile/ports.c62
-rw-r--r--libguile/r6rs-ports.c2
-rw-r--r--module/ice-9/deprecated.scm19
-rw-r--r--module/system/base/types.scm2
-rw-r--r--module/web/client.scm2
-rw-r--r--module/web/server/http.scm2
-rw-r--r--test-suite/tests/ports.test10
-rw-r--r--test-suite/tests/r6rs-ports.test16
12 files changed, 99 insertions, 68 deletions
diff --git a/NEWS b/NEWS
index 5885e2ef9..1be6c83a2 100644
--- a/NEWS
+++ b/NEWS
@@ -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):
diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm
index f0b25f541..a4ff9936f 100644
--- a/benchmark-suite/benchmarks/read.bm
+++ b/benchmark-suite/benchmarks/read.bm
@@ -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))
diff --git a/benchmark-suite/benchmarks/uniform-vector-read.bm b/benchmark-suite/benchmarks/uniform-vector-read.bm
index 8cda82457..01b747836 100644
--- a/benchmark-suite/benchmarks/uniform-vector-read.bm
+++ b/benchmark-suite/benchmarks/uniform-vector-read.bm
@@ -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)))
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 356941f2d..e5f1232ac 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -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.
diff --git a/libguile/ports.c b/libguile/ports.c
index 8ad3507b4..d394193ab 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -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)
- scm_out_of_range (FUNC_NAME, mode);
-
- if (cmode == _IOLBF)
+ if (scm_is_eq (mode, sym_none))
{
- SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
- cmode = _IOFBF;
+ tag_word |= SCM_BUF0;
+ if (!SCM_UNBNDP (size) && !scm_is_eq (size, SCM_INUM0))
+ scm_out_of_range (FUNC_NAME, size);
+ csize = 0;
}
- else
- SCM_SET_CELL_WORD_0 (port,
- SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
-
- if (SCM_UNBNDP (size))
+ else if (scm_is_eq (mode, sym_line))
{
- if (cmode == _IOFBF)
- csize = -1;
- else
- csize = 0;
+ csize = SCM_UNBNDP (size) ? -1 : scm_to_int (size);
+ tag_word |= SCM_BUFLINE;
}
- else
+ else if (scm_is_eq (mode, sym_block))
{
- csize = scm_to_int (size);
- if (csize < 0 || (cmode == _IONBF && csize > 0))
- scm_out_of_range (FUNC_NAME, size);
+ csize = SCM_UNBNDP (size) ? -1 : scm_to_int (size);
}
+ else
+ scm_out_of_range (FUNC_NAME, mode);
+
+ 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);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 2c2b657d7..e4f3b5ca2 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -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);
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 9835c1230..375846ff3 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -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)
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 26760d1d1..ea2f3bcaf 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -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)))
diff --git a/module/web/client.scm b/module/web/client.scm
index 11fee352d..f24a4d70a 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -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)
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index cda44f4aa..2184ad8a2 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -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*)
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index c43801db4..2bc719e90 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -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*)
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index dd4092512..674768ea1 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -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)