summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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))))