mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-14 15:40:19 +02:00
Make sure binary ports pass `binary-port?' regardless of the locale.
* libguile/r6rs-ports.c (make_bip, make_cbip, make_bop, make_cbop): Set `c_port->encoding' to NULL. * test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["bytevector-input-port is binary"]: New test. ("7.2.7 Input Ports")["make-custom-binary-input-port"]: Make sure PORT passes `binary-port?' and `input-port?'. ("8.2.10 Output ports")["bytevector-output-port is binary"]: New test. ["make-custom-binary-output"]: Rename to... ["make-custom-binary-output-port"]: ... this. * test-suite/tests/ports.test ("string ports")["read-char, wrong encoding, error", "read-char, wrong encoding, escape", "read-char, wrong encoding, substitute", "peek-char, wrong encoding, error"]: Use `set-port-encoding!' instead of `%default-port-encoding' to set the encoding of bytevector input ports. * test-suite/tests/rdelim.test ("read-line")["decoding error", "decoding error, substitute"]: Likewise. * doc/ref/api-io.texi (R6RS Port Manipulation): Document `binary-port?' and `textual-port?'. * doc/ref/r6rs.texi (R6RS Incompatibilities): Mention the soft distinction between textual and binary ports.
This commit is contained in:
parent
969bb92e9b
commit
96128014bf
6 changed files with 71 additions and 20 deletions
|
@ -1229,6 +1229,31 @@ Call @var{proc}, passing it @var{port} and closing @var{port} upon exit
|
||||||
of @var{proc}. Return the return values of @var{proc}.
|
of @var{proc}. Return the return values of @var{proc}.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} binary-port? port
|
||||||
|
Return @code{#t} if @var{port} is a @dfn{binary port}, suitable for
|
||||||
|
binary data input/output.
|
||||||
|
|
||||||
|
Note that internally Guile does not differentiate between binary and
|
||||||
|
textual ports, unlike the R6RS. Thus, this procedure returns true when
|
||||||
|
@var{port} does not have an associated encoding---i.e., when
|
||||||
|
@code{(port-encoding @var{port})} is @code{#f} (@pxref{Ports,
|
||||||
|
port-encoding}). This is the case for ports returned by R6RS procedures
|
||||||
|
such as @code{open-bytevector-input-port} and
|
||||||
|
@code{make-custom-binary-output-port}.
|
||||||
|
|
||||||
|
However, Guile currently does not prevent use of textual I/O procedures
|
||||||
|
such as @code{display} or @code{read-char} with binary ports. Doing so
|
||||||
|
``upgrades'' the port from binary to textual, under the ISO-8859-1
|
||||||
|
encoding. Likewise, Guile does not prevent use of
|
||||||
|
@code{set-port-encoding!} on a binary port, which also turns it into a
|
||||||
|
``textual'' port.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} textual-port? port
|
||||||
|
Always return @var{#t}, as all ports can be used for textual I/O in
|
||||||
|
Guile.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
@node R6RS Binary Input
|
@node R6RS Binary Input
|
||||||
@subsubsection Binary Input
|
@subsubsection Binary Input
|
||||||
|
|
|
@ -93,8 +93,13 @@ implement in a backward-compatible way. Suggestions and/or patches would
|
||||||
be appreciated.
|
be appreciated.
|
||||||
|
|
||||||
@item
|
@item
|
||||||
The @code{(rnrs io ports)} module is mostly unimplemented. Work is
|
The @code{(rnrs io ports)} module is incomplete. Work is
|
||||||
ongoing to fix this.
|
ongoing to fix this.
|
||||||
|
|
||||||
|
@item
|
||||||
|
Guile does not prevent use of textual I/O procedures on binary ports.
|
||||||
|
More generally, it does not make a sharp distinction between binary and
|
||||||
|
textual ports (@pxref{R6RS Port Manipulation, binary-port?}).
|
||||||
@end itemize
|
@end itemize
|
||||||
|
|
||||||
@node R6RS Standard Libraries
|
@node R6RS Standard Libraries
|
||||||
|
|
|
@ -87,6 +87,10 @@ make_bip (SCM bv)
|
||||||
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
|
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
|
||||||
|
|
||||||
port = scm_new_port_table_entry (bytevector_input_port_type);
|
port = scm_new_port_table_entry (bytevector_input_port_type);
|
||||||
|
c_port = SCM_PTAB_ENTRY (port);
|
||||||
|
|
||||||
|
/* Match the expectation of `binary-port?'. */
|
||||||
|
c_port->encoding = NULL;
|
||||||
|
|
||||||
/* Prevent BV from being GC'd. */
|
/* Prevent BV from being GC'd. */
|
||||||
SCM_SETSTREAM (port, SCM_UNPACK (bv));
|
SCM_SETSTREAM (port, SCM_UNPACK (bv));
|
||||||
|
@ -95,7 +99,6 @@ make_bip (SCM bv)
|
||||||
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
|
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
|
||||||
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
||||||
|
|
||||||
c_port = SCM_PTAB_ENTRY (port);
|
|
||||||
c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
|
c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
|
||||||
c_port->read_end = (unsigned char *) c_bv + c_len;
|
c_port->read_end = (unsigned char *) c_bv + c_len;
|
||||||
c_port->read_buf_size = c_len;
|
c_port->read_buf_size = c_len;
|
||||||
|
@ -312,12 +315,15 @@ make_cbip (SCM read_proc, SCM get_position_proc,
|
||||||
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
|
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
|
||||||
|
|
||||||
port = scm_new_port_table_entry (custom_binary_input_port_type);
|
port = scm_new_port_table_entry (custom_binary_input_port_type);
|
||||||
|
c_port = SCM_PTAB_ENTRY (port);
|
||||||
|
|
||||||
|
/* Match the expectation of `binary-port?'. */
|
||||||
|
c_port->encoding = NULL;
|
||||||
|
|
||||||
/* Attach it the method vector. */
|
/* Attach it the method vector. */
|
||||||
SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
|
SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
|
||||||
|
|
||||||
/* Have the port directly access the buffer (bytevector). */
|
/* Have the port directly access the buffer (bytevector). */
|
||||||
c_port = SCM_PTAB_ENTRY (port);
|
|
||||||
c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
|
c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
|
||||||
c_port->read_end = (unsigned char *) c_bv;
|
c_port->read_end = (unsigned char *) c_bv;
|
||||||
c_port->read_buf_size = c_len;
|
c_port->read_buf_size = c_len;
|
||||||
|
@ -827,11 +833,14 @@ make_bop (void)
|
||||||
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
|
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
|
||||||
|
|
||||||
port = scm_new_port_table_entry (bytevector_output_port_type);
|
port = scm_new_port_table_entry (bytevector_output_port_type);
|
||||||
|
c_port = SCM_PTAB_ENTRY (port);
|
||||||
|
|
||||||
|
/* Match the expectation of `binary-port?'. */
|
||||||
|
c_port->encoding = NULL;
|
||||||
|
|
||||||
buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
|
buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
|
||||||
bop_buffer_init (buf);
|
bop_buffer_init (buf);
|
||||||
|
|
||||||
c_port = SCM_PTAB_ENTRY (port);
|
|
||||||
c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
|
c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
|
||||||
c_port->write_buf_size = 0;
|
c_port->write_buf_size = 0;
|
||||||
|
|
||||||
|
@ -983,12 +992,15 @@ make_cbop (SCM write_proc, SCM get_position_proc,
|
||||||
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
|
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
|
||||||
|
|
||||||
port = scm_new_port_table_entry (custom_binary_output_port_type);
|
port = scm_new_port_table_entry (custom_binary_output_port_type);
|
||||||
|
c_port = SCM_PTAB_ENTRY (port);
|
||||||
|
|
||||||
|
/* Match the expectation of `binary-port?'. */
|
||||||
|
c_port->encoding = NULL;
|
||||||
|
|
||||||
/* Attach it the method vector. */
|
/* Attach it the method vector. */
|
||||||
SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
|
SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
|
||||||
|
|
||||||
/* Have the port directly access the buffer (bytevector). */
|
/* Have the port directly access the buffer (bytevector). */
|
||||||
c_port = SCM_PTAB_ENTRY (port);
|
|
||||||
c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
|
c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
|
||||||
c_port->write_buf_size = c_port->read_buf_size = 0;
|
c_port->write_buf_size = c_port->read_buf_size = 0;
|
||||||
|
|
||||||
|
|
|
@ -463,10 +463,10 @@
|
||||||
(= (port-column p) 0))))
|
(= (port-column p) 0))))
|
||||||
|
|
||||||
(pass-if "read-char, wrong encoding, error"
|
(pass-if "read-char, wrong encoding, error"
|
||||||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
(let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
|
||||||
(open-bytevector-input-port #vu8(255 65 66 67)))))
|
|
||||||
(catch 'decoding-error
|
(catch 'decoding-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
(set-port-encoding! p "UTF-8")
|
||||||
(set-port-conversion-strategy! p 'error)
|
(set-port-conversion-strategy! p 'error)
|
||||||
(read-char p)
|
(read-char p)
|
||||||
#f)
|
#f)
|
||||||
|
@ -483,10 +483,10 @@
|
||||||
|
|
||||||
(pass-if "read-char, wrong encoding, escape"
|
(pass-if "read-char, wrong encoding, escape"
|
||||||
;; `escape' should behave exactly like `error'.
|
;; `escape' should behave exactly like `error'.
|
||||||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
(let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
|
||||||
(open-bytevector-input-port #vu8(255 65 66 67)))))
|
|
||||||
(catch 'decoding-error
|
(catch 'decoding-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
(set-port-encoding! p "UTF-8")
|
||||||
(set-port-conversion-strategy! p 'escape)
|
(set-port-conversion-strategy! p 'escape)
|
||||||
(read-char p)
|
(read-char p)
|
||||||
#f)
|
#f)
|
||||||
|
@ -502,8 +502,8 @@
|
||||||
(eof-object? (read-char port)))))))
|
(eof-object? (read-char port)))))))
|
||||||
|
|
||||||
(pass-if "read-char, wrong encoding, substitute"
|
(pass-if "read-char, wrong encoding, substitute"
|
||||||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
(let ((p (open-bytevector-input-port #vu8(255 206 187 206 188))))
|
||||||
(open-bytevector-input-port #vu8(255 206 187 206 188)))))
|
(set-port-encoding! p "UTF-8")
|
||||||
(set-port-conversion-strategy! p 'substitute)
|
(set-port-conversion-strategy! p 'substitute)
|
||||||
(equal? (list (read-char p) (read-char p) (read-char p))
|
(equal? (list (read-char p) (read-char p) (read-char p))
|
||||||
'(#\? #\λ #\μ))))
|
'(#\? #\λ #\μ))))
|
||||||
|
@ -518,8 +518,8 @@
|
||||||
#f)
|
#f)
|
||||||
(lambda (key subr message errno p)
|
(lambda (key subr message errno p)
|
||||||
(eq? p port)))))))
|
(eq? p port)))))))
|
||||||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
(let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
|
||||||
(open-bytevector-input-port #vu8(255 65 66 67)))))
|
(set-port-encoding! p "UTF-8")
|
||||||
(set-port-conversion-strategy! p 'error)
|
(set-port-conversion-strategy! p 'error)
|
||||||
|
|
||||||
;; `peek-char' should repeatedly raise an error.
|
;; `peek-char' should repeatedly raise an error.
|
||||||
|
|
|
@ -294,6 +294,10 @@
|
||||||
|
|
||||||
(equal? (read-to-string port) str)))
|
(equal? (read-to-string port) str)))
|
||||||
|
|
||||||
|
(pass-if "bytevector-input-port is binary"
|
||||||
|
(with-fluids ((%default-port-encoding "UTF-8"))
|
||||||
|
(binary-port? (open-bytevector-input-port #vu8(1 2 3)))))
|
||||||
|
|
||||||
(pass-if-exception "bytevector-input-port is read-only"
|
(pass-if-exception "bytevector-input-port is read-only"
|
||||||
exception:wrong-type-arg
|
exception:wrong-type-arg
|
||||||
|
|
||||||
|
@ -350,7 +354,9 @@
|
||||||
(port (make-custom-binary-input-port "the port" read!
|
(port (make-custom-binary-input-port "the port" read!
|
||||||
#f #f #f)))
|
#f #f #f)))
|
||||||
|
|
||||||
(bytevector=? (get-bytevector-all port) source)))
|
(and (binary-port? port)
|
||||||
|
(input-port? port)
|
||||||
|
(bytevector=? (get-bytevector-all port) source))))
|
||||||
|
|
||||||
(pass-if "custom binary input port does not support `port-position'"
|
(pass-if "custom binary input port does not support `port-position'"
|
||||||
(let* ((str "Hello Port!")
|
(let* ((str "Hello Port!")
|
||||||
|
@ -423,6 +429,9 @@
|
||||||
(and (bytevector=? (get-content) source)
|
(and (bytevector=? (get-content) source)
|
||||||
(bytevector=? (get-content) (make-bytevector 0))))))
|
(bytevector=? (get-content) (make-bytevector 0))))))
|
||||||
|
|
||||||
|
(pass-if "bytevector-output-port is binary"
|
||||||
|
(binary-port? (open-bytevector-output-port)))
|
||||||
|
|
||||||
(pass-if "open-bytevector-output-port [extract after close]"
|
(pass-if "open-bytevector-output-port [extract after close]"
|
||||||
(let-values (((port get-content)
|
(let-values (((port get-content)
|
||||||
(open-bytevector-output-port)))
|
(open-bytevector-output-port)))
|
||||||
|
@ -468,7 +477,7 @@
|
||||||
(bytevector=? (get-content) source)
|
(bytevector=? (get-content) source)
|
||||||
(bytevector=? (get-content) (make-bytevector 0))))))
|
(bytevector=? (get-content) (make-bytevector 0))))))
|
||||||
|
|
||||||
(pass-if "make-custom-binary-output"
|
(pass-if "make-custom-binary-output-port"
|
||||||
(let ((port (make-custom-binary-output-port "cbop"
|
(let ((port (make-custom-binary-output-port "cbop"
|
||||||
(lambda (x y z) 0)
|
(lambda (x y z) 0)
|
||||||
#f #f #f)))
|
#f #f #f)))
|
||||||
|
|
|
@ -72,8 +72,8 @@
|
||||||
(eof-object? (read-line p)))))
|
(eof-object? (read-line p)))))
|
||||||
|
|
||||||
(pass-if "decoding error"
|
(pass-if "decoding error"
|
||||||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
(let ((p (open-bytevector-input-port #vu8(65 255 66 67 68))))
|
||||||
(open-bytevector-input-port #vu8(65 255 66 67 68)))))
|
(set-port-encoding! p "UTF-8")
|
||||||
(set-port-conversion-strategy! p 'error)
|
(set-port-conversion-strategy! p 'error)
|
||||||
(catch 'decoding-error
|
(catch 'decoding-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -87,8 +87,8 @@
|
||||||
(eof-object? (read-line p)))))))
|
(eof-object? (read-line p)))))))
|
||||||
|
|
||||||
(pass-if "decoding error, substitute"
|
(pass-if "decoding error, substitute"
|
||||||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
(let ((p (open-bytevector-input-port #vu8(65 255 66 67 68))))
|
||||||
(open-bytevector-input-port #vu8(65 255 66 67 68)))))
|
(set-port-encoding! p "UTF-8")
|
||||||
(set-port-conversion-strategy! p 'substitute)
|
(set-port-conversion-strategy! p 'substitute)
|
||||||
(and (string=? (read-line p) "A?BCD")
|
(and (string=? (read-line p) "A?BCD")
|
||||||
(eof-object? (read-line p))))))
|
(eof-object? (read-line p))))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue