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

Implement R6RS output-port-buffer-mode

Browse source 
* module/rnrs/io/ports.scm (r6rs-open): Set buffer-mode on new port.
  (output-port-buffer-mode): Implement and export.
* module/rnrs.scm (rnrs): Export output-port-buffer-mode
* test-suite/tests/r6rs-ports.test (test-output-file-opener): Add
  tests.
This commit is contained in:
Andy Wingo 2016-06-21 11:06:25 +02:00
parent d545e4551d
commit 5d9516637b
3 changed files with 36 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/rnrs.scm
View file

@ -183,7 +183,7 @@
open-file-input-port open-file-output-port open-file-input/output-port
make-custom-textual-output-port
call-with-string-output-port
flush-output-port put-string
output-port-buffer-mode flush-output-port put-string
get-char get-datum get-line get-string-all get-string-n get-string-n!
lookahead-char
put-char put-datum put-string

19
module/rnrs/io/ports.scm
View file

@ -63,6 +63,7 @@
call-with-bytevector-output-port
call-with-string-output-port
make-custom-textual-output-port
output-port-buffer-mode
flush-output-port
;; input/output ports
@ -106,6 +107,9 @@
make-i/o-encoding-error i/o-encoding-error-char)
(import (ice-9 binary-ports)
(only (rnrs base) assertion-violation)
(only (ice-9 ports internal)
port-write-buffer port-buffer-bytevector port-line-buffered?)
(only (rnrs bytevectors) bytevector-length)
(rnrs enums)
(rnrs records syntactic)
(rnrs exceptions)
@ -310,8 +314,9 @@ read from/written to in @var{port}."
(lambda ()
(with-fluids ((%default-port-encoding #f))
(open filename mode))))))
(cond (transcoder
(set-port-encoding! port (transcoder-codec transcoder))))
(setvbuf port buffer-mode)
(when transcoder
(set-port-encoding! port (transcoder-codec transcoder)))
port))
(define (file-options->mode file-options base-mode)
@ -382,6 +387,16 @@ return the characters accumulated in that port."
close)
"w"))
(define (output-port-buffer-mode port)
"Return @code{none} if @var{port} is unbuffered, @code{line} if it is
line buffered, or @code{block} otherwise."
(let ((buffering (bytevector-length
(port-buffer-bytevector (port-write-buffer port)))))
(cond
((= buffering 1) 'none)
((port-line-buffered? port) 'line)
(else 'block))))
(define (flush-output-port port)
(force-output port))

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

@ -716,6 +716,24 @@ not `set-port-position!'"
binary-port?)
(= 0 (stat:size (stat filename)))))
(pass-if "buffer-mode none"
(call-with-port (open filename (file-options no-fail)
(buffer-mode none))
(lambda (port)
(eq? (output-port-buffer-mode port) 'none))))
(pass-if "buffer-mode line"
(call-with-port (open filename (file-options no-fail)
(buffer-mode line))
(lambda (port)
(eq? (output-port-buffer-mode port) 'line))))
(pass-if "buffer-mode block"
(call-with-port (open filename (file-options no-fail)
(buffer-mode block))
(lambda (port)
(eq? (output-port-buffer-mode port) 'block))))
(delete-file filename)
(pass-if-condition "exception: does-not-exist"