[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Fix bytevector and custom binary ports to actuall
|
From: |
Mark H. Weaver |
|
Subject: |
[Guile-commits] 01/01: Fix bytevector and custom binary ports to actually use ISO-8859-1 encoding. |
|
Date: |
Sat, 28 Mar 2015 20:12:08 +0000 |
mhw pushed a commit to branch stable-2.0
in repository guile.
commit d574d96f879c147c6c14df43f2e4ff9e8a6876b9
Author: Mark H Weaver <address@hidden>
Date: Sat Mar 28 16:01:23 2015 -0400
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 <address@hidden>.
* 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.
---
libguile/ports.c | 5 ++++
libguile/r6rs-ports.c | 8 ++++++
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 f5d5284..8799aca 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 93171f0..a17b7b4 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 e5f1266..7bf9ffa 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))))