mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 02:00:26 +02:00
Code Activity

Enhance transcoder-related functionality of `(rnrs io ports)'

Browse source 
* 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.
  (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'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Andreas Rottmann 2011-03-13 23:14:10 +01:00 • committed by Ludovic Courtès
parent 74571cfd3b
commit ead04a04cd
3 changed files with 66 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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))))))
(with-test-prefix "8.2.9 Textual input"