mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-15 18:20:42 +02:00
Code Activity

Fix bytevector and custom binary ports to actually use ISO-8859-1 encoding.

Browse source 
Fixes <http://bugs.gnu.org/20200>, introduced in
  commit 337edc591f.
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.
This commit is contained in:
Mark H Weaver 2015-03-28 16:01:23 -04:00
parent 2c032c2215
commit d574d96f87
3 changed files with 59 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/ports.c
View file

@ -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

8
libguile/r6rs-ports.c
View file

@ -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));

46
test-suite/tests/r6rs-ports.test
View file

@ -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))))