diff options
author | Andreas Rottmann <a.rottmann@gmx.at> | 2011-05-27 15:32:01 +0200 |
---|---|---|
committer | Andreas Rottmann <a.rottmann@gmx.at> | 2011-05-27 15:32:01 +0200 |
commit | 0687e826a12e45cec9fcf14ed642f176d230afb9 (patch) | |
tree | febb98c86c819842d1492a31522d35deb86b4c41 | |
parent | dfc4d56df1854e1c93606fa03497ff7218357e3d (diff) | |
download | guile-0687e826a12e45cec9fcf14ed642f176d230afb9.tar.gz |
rnrs io ports: fix port encoding when opening file ports
* module/rnrs/io/ports.scm (open-file-input-port)
(open-file-output-port): Ensure the resulting ports are binary when no
transcoder is specified.
* test-suite/tests/r6rs-ports.test: Remove superfluous global change of
`%default-port-encoding' and accompanying comment.
("7.2.7 Input Ports"): Add test ensuring `open-file-input-port' opens
a binary port when no transcoder is specified.
("8.2.10 Output ports"): Strengthen existing `open-file-output-port'
binary-ness test by setting `%default-port-encoding' to "UTF-8".
-rw-r--r-- | module/rnrs/io/ports.scm | 8 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 33 |
2 files changed, 28 insertions, 13 deletions
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index 4ae01be68..246e46b39 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -311,7 +311,9 @@ read from/written to in @var{port}." (buffer-mode (buffer-mode block)) maybe-transcoder) (let ((port (with-i/o-filename-conditions filename - (lambda () (open filename O_RDONLY))))) + (lambda () + (with-fluids ((%default-port-encoding #f)) + (open filename O_RDONLY)))))) (cond (maybe-transcoder (set-port-encoding! port (transcoder-codec maybe-transcoder)))) port)) @@ -340,7 +342,9 @@ as a string, and a thunk to retrieve the characters associated with that port." 0 O_EXCL))) (port (with-i/o-filename-conditions filename - (lambda () (open filename flags))))) + (lambda () + (with-fluids ((%default-port-encoding #f)) + (open filename flags)))))) (cond (maybe-transcoder (set-port-encoding! port (transcoder-codec maybe-transcoder)))) port)) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index feef48d40..f3e8c2c5d 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -27,12 +27,6 @@ #:use-module (rnrs exceptions) #:use-module (rnrs bytevectors)) -;;; All these tests assume Guile 1.8's port system, where characters are -;;; treated as octets. - -;; Set the default encoding of future ports to be Latin-1. -(fluid-set! %default-port-encoding #f) - (define-syntax pass-if-condition (syntax-rules () ((_ name predicate body0 body ...) @@ -322,6 +316,22 @@ (with-test-prefix "7.2.7 Input Ports" + (let ((filename (test-file)) + (contents (string->utf8 "GNU λ"))) + + ;; Create file + (call-with-output-file filename + (lambda (port) (put-bytevector port contents))) + + (pass-if "open-file-input-port [opens binary port]" + (with-fluids ((%default-port-encoding "UTF-8")) + (call-with-port (open-file-input-port filename) + (lambda (port) + (and (binary-port? port) + (bytevector=? contents (get-bytevector-all port))))))) + + (delete-file filename)) + ;; This section appears here so that it can use the binary input ;; primitives. @@ -469,11 +479,12 @@ (with-test-prefix "8.2.10 Output ports" (let ((filename (test-file))) - (pass-if "open-file-output-port [opens binary port]" - (call-with-port (open-file-output-port filename) - (lambda (port) - (put-bytevector port '#vu8(1 2 3)) - (binary-port? port)))) + (with-fluids ((%default-port-encoding "UTF-8")) + (pass-if "open-file-output-port [opens binary port]" + (call-with-port (open-file-output-port filename) + (lambda (port) + (put-bytevector port '#vu8(1 2 3)) + (binary-port? port))))) (pass-if-condition "open-file-output-port [exception: already-exists]" i/o-file-already-exists-error? |