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

R6RS: Have put-char', put-string', etc. raise an `&i/o-encoding-error'.

Browse source 
* module/rnrs/io/ports.scm (&i/o-encoding): New error condition type.
  (with-i/o-encoding-error): New macro.
  (put-char, put-datum, put-string): Use it.

* test-suite/tests/r6rs-ports.test ("8.2.6  Input and output
  ports")["transcoded-port, output [error handling mode = raise]"]: New
  test.
This commit is contained in:
Ludovic Courtès 2011-02-02 18:00:49 +01:00
parent 6851d3be80
commit eed98cbc92
2 changed files with 48 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -552,7 +552,20 @@
(error-handling-mode replace)))
(b (open-bytevector-input-port #vu8(255 1 2 3 103 110 117)))
(tp (transcoded-port b t)))
(string-suffix? "gnu" (get-line tp)))))
(string-suffix? "gnu" (get-line tp))))
(pass-if "transcoded-port, output [error handling mode = raise]"
(let-values (((p get)
(open-bytevector-output-port)))
(let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
(error-handling-mode raise)))
(tp (transcoded-port p t)))
(guard (c ((i/o-encoding-error? c)
(and (eq? (i/o-error-port c) tp)
(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)))))
;;; Local Variables:
;;; mode: scheme