summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2015-03-28 16:01:23 -0400
committerMark H Weaver <mhw@netris.org>2015-03-28 16:01:23 -0400
commitd574d96f879c147c6c14df43f2e4ff9e8a6876b9 (patch)
treeaf0ab2780d2cbe09afe5a924d8d74932741f1974
parent2c032c221506841403fd3078641c3bf92535540c (diff)
downloadguile-d574d96f879c147c6c14df43f2e4ff9e8a6876b9.tar.gz
Fix bytevector and custom binary ports to actually use ISO-8859-1 encoding.
Fixes <http://bugs.gnu.org/20200>, introduced in commit 337edc591ffd8f8ec4176b0112ad10da29818141. Reported by David Kastrup <dak@gnu.org>. * libguile/r6rs-ports.c (make_bip, make_cbip, make_bop, make_cbop): After setting port encoding = NULL, update 'encoding_mode' accordingly. * libguile/ports.c (scm_i_set_port_encoding_x): Add warning comment. * test-suite/tests/r6rs-ports.test: Add tests.
-rw-r--r--libguile/ports.c5
-rw-r--r--libguile/r6rs-ports.c8
-rw-r--r--test-suite/tests/r6rs-ports.test46
3 files changed, 59 insertions, 0 deletions
diff --git a/libguile/ports.c b/libguile/ports.c
index f5d528462..8799acaa6 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2580,6 +2580,11 @@ scm_i_set_port_encoding_x (SCM port, const char *encoding)
because we do I/O ourselves. This saves 100+ KiB for each
descriptor. */
pt->encoding = scm_gc_strdup (encoding, "port");
+
+ /* IMPORTANT: If the set of encoding modes is changed, or if more
+ would need to be done after setting pt->encoding = NULL, then
+ update 'make_bip', 'make_cbip', 'make_bop', and 'make_cbop' in
+ r6rs-ports.c accordingly. This will be cleaned up in 2.2. */
if (c_strcasecmp (encoding, "UTF-8") == 0)
pti->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
else
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 93171f06d..a17b7b408 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -89,6 +89,8 @@ make_bip (SCM bv)
/* Match the expectation of `binary-port?'. */
c_port->encoding = NULL;
+ /* XXX Manually update encoding_mode. This will be cleaned up in 2.2. */
+ SCM_PORT_GET_INTERNAL (port)->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
/* Prevent BV from being GC'd. */
SCM_SETSTREAM (port, SCM_UNPACK (bv));
@@ -362,6 +364,8 @@ make_cbip (SCM read_proc, SCM get_position_proc,
/* Match the expectation of `binary-port?'. */
c_port->encoding = NULL;
+ /* XXX Manually update encoding_mode. This will be cleaned up in 2.2. */
+ SCM_PORT_GET_INTERNAL (port)->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
/* Attach it the method vector. */
SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
@@ -912,6 +916,8 @@ make_bop (void)
/* Match the expectation of `binary-port?'. */
c_port->encoding = NULL;
+ /* XXX Manually update encoding_mode. This will be cleaned up in 2.2. */
+ SCM_PORT_GET_INTERNAL (port)->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
bop_buffer_init (buf);
@@ -1071,6 +1077,8 @@ make_cbop (SCM write_proc, SCM get_position_proc,
/* Match the expectation of `binary-port?'. */
c_port->encoding = NULL;
+ /* XXX Manually update encoding_mode. This will be cleaned up in 2.2. */
+ SCM_PORT_GET_INTERNAL (port)->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
/* Attach it the method vector. */
SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index e5f1266a0..7bf9ffa49 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -357,6 +357,11 @@
(with-fluids ((%default-port-encoding "UTF-8"))
(binary-port? (open-bytevector-input-port #vu8(1 2 3)))))
+ (pass-if-equal "bytevector-input-port uses ISO-8859-1 (Guile extension)"
+ "©©"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (get-string-all (open-bytevector-input-port #vu8(194 169 194 169)))))
+
(pass-if-exception "bytevector-input-port is read-only"
exception:wrong-type-arg
@@ -417,6 +422,23 @@
(input-port? port)
(bytevector=? (get-bytevector-all port) source))))
+ (pass-if-equal "make-custom-binary-input-port uses ISO-8859-1 (Guile extension)"
+ "©©"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (let* ((source #vu8(194 169 194 169))
+ (read! (let ((pos 0)
+ (len (bytevector-length source)))
+ (lambda (bv start count)
+ (let ((amount (min count (- len pos))))
+ (if (> amount 0)
+ (bytevector-copy! source pos
+ bv start amount))
+ (set! pos (+ pos amount))
+ amount))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+ (get-string-all port))))
+
(pass-if "custom binary input port does not support `port-position'"
(let* ((str "Hello Port!")
(source (open-bytevector-input-port
@@ -717,6 +739,14 @@ not `set-port-position!'"
(pass-if "bytevector-output-port is binary"
(binary-port? (open-bytevector-output-port)))
+ (pass-if-equal "bytevector-output-port uses ISO-8859-1 (Guile extension)"
+ #vu8(194 169 194 169)
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (let-values (((port get-content)
+ (open-bytevector-output-port)))
+ (put-string port "©©")
+ (get-content))))
+
(pass-if "open-bytevector-output-port [extract after close]"
(let-values (((port get-content)
(open-bytevector-output-port)))
@@ -818,6 +848,22 @@ not `set-port-position!'"
(not eof?)
(bytevector=? sink source))))
+ (pass-if-equal "custom-binary-output-port uses ISO-8859-1 (Guile extension)"
+ '(194 169 194 169)
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (let* ((sink '())
+ (write! (lambda (bv start count)
+ (if (= 0 count) ; EOF
+ 0
+ (let ((u8 (bytevector-u8-ref bv start)))
+ ;; Get one byte at a time.
+ (set! sink (cons u8 sink))
+ 1))))
+ (port (make-custom-binary-output-port "cbop" write!
+ #f #f #f)))
+ (put-string port "©©")
+ (reverse sink))))
+
(pass-if "standard-output-port is binary"
(with-fluids ((%default-port-encoding "UTF-8"))
(binary-port? (standard-output-port))))