diff options
-rw-r--r-- | doc/ref/api-io.texi | 25 | ||||
-rw-r--r-- | doc/ref/r6rs.texi | 7 | ||||
-rw-r--r-- | libguile/r6rs-ports.c | 20 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 16 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 15 | ||||
-rw-r--r-- | test-suite/tests/rdelim.test | 8 |
6 files changed, 71 insertions, 20 deletions
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 02c184986..4786d79a4 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -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}. @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 @subsubsection Binary Input diff --git a/doc/ref/r6rs.texi b/doc/ref/r6rs.texi index bc569ed69..2fe8d7b76 100644 --- a/doc/ref/r6rs.texi +++ b/doc/ref/r6rs.texi @@ -93,8 +93,13 @@ implement in a backward-compatible way. Suggestions and/or patches would be appreciated. @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. + +@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 @node R6RS Standard Libraries diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 7473db94b..b9d52829f 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -87,6 +87,10 @@ make_bip (SCM bv) scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); 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. */ SCM_SETSTREAM (port, SCM_UNPACK (bv)); @@ -95,7 +99,6 @@ make_bip (SCM bv) c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (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_end = (unsigned char *) c_bv + 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); 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. */ SCM_SETSTREAM (port, SCM_UNPACK (method_vector)); /* 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_end = (unsigned char *) c_bv; c_port->read_buf_size = c_len; @@ -827,11 +833,14 @@ make_bop (void) scm_i_pthread_mutex_lock (&scm_i_port_table_mutex); 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); 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_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); 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. */ SCM_SETSTREAM (port, SCM_UNPACK (method_vector)); /* 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_size = c_port->read_buf_size = 0; diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 72b58aea5..9d3000cc1 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -463,10 +463,10 @@ (= (port-column p) 0)))) (pass-if "read-char, wrong encoding, error" - (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(255 65 66 67))))) + (let ((p (open-bytevector-input-port #vu8(255 65 66 67)))) (catch 'decoding-error (lambda () + (set-port-encoding! p "UTF-8") (set-port-conversion-strategy! p 'error) (read-char p) #f) @@ -483,10 +483,10 @@ (pass-if "read-char, wrong encoding, escape" ;; `escape' should behave exactly like `error'. - (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(255 65 66 67))))) + (let ((p (open-bytevector-input-port #vu8(255 65 66 67)))) (catch 'decoding-error (lambda () + (set-port-encoding! p "UTF-8") (set-port-conversion-strategy! p 'escape) (read-char p) #f) @@ -502,8 +502,8 @@ (eof-object? (read-char port))))))) (pass-if "read-char, wrong encoding, substitute" - (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(255 206 187 206 188))))) + (let ((p (open-bytevector-input-port #vu8(255 206 187 206 188)))) + (set-port-encoding! p "UTF-8") (set-port-conversion-strategy! p 'substitute) (equal? (list (read-char p) (read-char p) (read-char p)) '(#\? #\λ #\μ)))) @@ -518,8 +518,8 @@ #f) (lambda (key subr message errno p) (eq? p port))))))) - (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(255 65 66 67))))) + (let ((p (open-bytevector-input-port #vu8(255 65 66 67)))) + (set-port-encoding! p "UTF-8") (set-port-conversion-strategy! p 'error) ;; `peek-char' should repeatedly raise an error. diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 01d8235fa..06431bb76 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -294,6 +294,10 @@ (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" exception:wrong-type-arg @@ -350,7 +354,9 @@ (port (make-custom-binary-input-port "the port" read! #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'" (let* ((str "Hello Port!") @@ -422,7 +428,10 @@ (put-bytevector port source) (and (bytevector=? (get-content) source) (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]" (let-values (((port get-content) (open-bytevector-output-port))) @@ -468,7 +477,7 @@ (bytevector=? (get-content) source) (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" (lambda (x y z) 0) #f #f #f))) diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test index f827f62a0..e61fc9246 100644 --- a/test-suite/tests/rdelim.test +++ b/test-suite/tests/rdelim.test @@ -72,8 +72,8 @@ (eof-object? (read-line p))))) (pass-if "decoding error" - (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(65 255 66 67 68))))) + (let ((p (open-bytevector-input-port #vu8(65 255 66 67 68)))) + (set-port-encoding! p "UTF-8") (set-port-conversion-strategy! p 'error) (catch 'decoding-error (lambda () @@ -87,8 +87,8 @@ (eof-object? (read-line p))))))) (pass-if "decoding error, substitute" - (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(65 255 66 67 68))))) + (let ((p (open-bytevector-input-port #vu8(65 255 66 67 68)))) + (set-port-encoding! p "UTF-8") (set-port-conversion-strategy! p 'substitute) (and (string=? (read-line p) "A?BCD") (eof-object? (read-line p)))))) |