[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Several tweaks for R6RS ports
From: |
Andreas Rottmann |
Subject: |
Re: [PATCH] Several tweaks for R6RS ports |
Date: |
Tue, 08 Mar 2011 01:58:22 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) |
Andreas Rottmann <address@hidden> writes:
> Hi!
>
> Here's a few patches related to R6RS port support, in short:
>
> - Add missing `get-string-n!' and `get-string-n'
> - Fix a few missing exports
> - A bit of work on transcoder-related stuff
>
Attached is an updated version of the "rnrs-transcoders" patch; relative
to its predecessor, it just adds `textual-port?' to the exports in
`(rnrs)' and has a few tweaks to the ChangeLog entries.
From: Andreas Rottmann <address@hidden>
Subject: Enhance transcoder-related functionality of `(rnrs io ports)'
* module/rnrs/io/ports.scm (transcoder-eol-style)
(transcoder-error-handling-mode): Export these.
(textual-port?): Implement this procedure and export it.
* module/rnrs.scm: Export these here as well.
* module/rnrs/io/ports.scm (port-transcoder): Implement this procedure.
(binary-port?): Treat only ports without an encoding as binary ports,
add docstring.
* module/rnrs/io/ports.scm: (standard-input-port, standard-output-port)
(standard-error-port): Ensure these are created without an encoding.
(eol-style): Add `none' as enumeration member.
(native-eol-style): Switch to `none' from `lf'.
* test-suite/tests/r6rs-ports.test (7.2.7 Input ports)
(8.2.10 Output ports): Test binary-ness of `standard-input-port',
`standard-output-port' and `standard-error-port'.
(8.2.6 Input and output ports): Add test for `port-transcoder'.
---
module/rnrs.scm | 6 +++-
module/rnrs/io/ports.scm | 42 +++++++++++++++++++++++++++++--------
test-suite/tests/r6rs-ports.test | 32 ++++++++++++++++++++++++++--
3 files changed, 66 insertions(+), 14 deletions(-)
diff --git a/module/rnrs.scm b/module/rnrs.scm
index 476a3ab..6fde880 100644
--- a/module/rnrs.scm
+++ b/module/rnrs.scm
@@ -162,12 +162,14 @@
file-options buffer-mode buffer-mode?
eol-style native-eol-style error-handling-mode
- make-transcoder transcoder-codec native-transcoder
+ make-transcoder transcoder-codec transcoder-eol-style
+ transcoder-error-handling-mode native-transcoder
latin-1-codec utf-8-codec utf-16-codec
eof-object? port? input-port? output-port? eof-object port-eof?
port-transcoder
- binary-port? transcoded-port port-position set-port-position!
+ binary-port? textual-port? transcoded-port
+ port-position set-port-position!
port-has-port-position? port-has-set-port-position!?
close-port call-with-port
open-bytevector-input-port make-custom-binary-input-port get-u8
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index b98811a..097c9d3 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -32,13 +32,14 @@
;; auxiliary types
file-options buffer-mode buffer-mode?
eol-style native-eol-style error-handling-mode
- make-transcoder transcoder-codec native-transcoder
+ make-transcoder transcoder-codec transcoder-eol-style
+ transcoder-error-handling-mode native-transcoder
latin-1-codec utf-8-codec utf-16-codec
;; input & output ports
port? input-port? output-port?
port-eof?
- port-transcoder binary-port? transcoded-port
+ port-transcoder binary-port? textual-port? transcoded-port
port-position set-port-position!
port-has-port-position? port-has-set-port-position!?
call-with-port close-port
@@ -128,11 +129,11 @@
(enum-set-member? symbol (enum-set-universe (buffer-modes))))
(define-enumeration eol-style
- (lf cr crlf nel crnel ls)
+ (lf cr crlf nel crnel ls none)
eol-styles)
(define (native-eol-style)
- (eol-style lf))
+ (eol-style none))
(define-enumeration error-handling-mode
(ignore raise replace)
@@ -189,10 +190,30 @@
;;;
(define (port-transcoder port)
- (error "port transcoders are not supported" port))
+ "Return the transcoder object associated with @var{port}, or @code{#f}
+if the port has no transcoder."
+ (cond ((port-encoding port)
+ => (lambda (encoding)
+ (make-transcoder
+ encoding
+ (native-eol-style)
+ (case (port-conversion-strategy port)
+ ((error) 'raise)
+ ((substitute) 'replace)
+ (else
+ (assertion-violation 'port-transcoder
+ "unsupported error handling mode"))))))
+ (else
+ #f)))
(define (binary-port? port)
- ;; So far, we don't support transcoders other than the binary transcoder.
+ "Returns @code{#t} if @var{port} does not have an associated encoding,
address@hidden otherwise."
+ (not (port-encoding port)))
+
+(define (textual-port? port)
+ "Always returns @var{#t}, as all ports can be used for textual I/O in
+Guile."
#t)
(define (port-eof? port)
@@ -396,13 +417,16 @@ return the characters accumulated in that port."
;;;
(define (standard-input-port)
- (dup->inport 0))
+ (with-fluids ((%default-port-encoding #f))
+ (dup->inport 0)))
(define (standard-output-port)
- (dup->outport 1))
+ (with-fluids ((%default-port-encoding #f))
+ (dup->outport 1)))
(define (standard-error-port)
- (dup->outport 2))
+ (with-fluids ((%default-port-encoding #f))
+ (dup->outport 2)))
)
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index df056a4..d0f5666 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -397,7 +397,11 @@
(close-port port)
(gc) ; Test for marking a closed port.
- closed?)))
+ closed?))
+
+ (pass-if "standard-input-port is binary"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (binary-port? (standard-input-port)))))
(with-test-prefix "8.2.10 Output ports"
@@ -509,7 +513,15 @@
(put-bytevector port source)
(and (= sink-pos (bytevector-length source))
(not eof?)
- (bytevector=? sink source)))))
+ (bytevector=? sink source))))
+
+ (pass-if "standard-output-port is binary"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (binary-port? (standard-output-port))))
+
+ (pass-if "standard-error-port is binary"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (binary-port? (standard-error-port)))))
(with-test-prefix "8.2.6 Input and output ports"
@@ -565,7 +577,21 @@
(char=? (i/o-encoding-error-char c) #\λ)
(bytevector=? (get) (string->utf8 "The letter ")))))
(put-string tp "The letter λ cannot be represented in Latin-1.")
- #f)))))
+ #f))))
+
+ (pass-if "port-transcoder [binary port]"
+ (not (port-transcoder (open-bytevector-input-port #vu8()))))
+
+ (pass-if "port-transcoder [transcoded port]"
+ (let* ((p (transcoded-port (open-bytevector-input-port (string->utf8
"foo"))
+ (make-transcoder (utf-8-codec))))
+ (t (port-transcoder p)))
+ (and t
+ (transcoder-codec t)
+ (eq? (native-eol-style)
+ (transcoder-eol-style t))
+ (eq? (error-handling-mode replace)
+ (transcoder-error-handling-mode t))))))
;;; Local Variables:
;;; mode: scheme
--
tg: (9421ef5..) t/rnrs-transcoders (depends on: t/rnrs-io-current-ports)
Regards, Rotty
--
Andreas Rottmann -- <http://rotty.yi.org/>