summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Rottmann <a.rottmann@gmx.at>2011-05-27 15:32:01 +0200
committerAndreas Rottmann <a.rottmann@gmx.at>2011-05-27 15:32:01 +0200
commit0687e826a12e45cec9fcf14ed642f176d230afb9 (patch)
treefebb98c86c819842d1492a31522d35deb86b4c41
parentdfc4d56df1854e1c93606fa03497ff7218357e3d (diff)
downloadguile-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.scm8
-rw-r--r--test-suite/tests/r6rs-ports.test33
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?