diff options
author | Mark H Weaver <mhw@netris.org> | 2015-03-28 16:01:23 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2015-03-28 16:01:23 -0400 |
commit | d574d96f879c147c6c14df43f2e4ff9e8a6876b9 (patch) | |
tree | af0ab2780d2cbe09afe5a924d8d74932741f1974 | |
parent | 2c032c221506841403fd3078641c3bf92535540c (diff) | |
download | guile-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.c | 5 | ||||
-rw-r--r-- | libguile/r6rs-ports.c | 8 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 46 |
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)))) |