diff options
author | Andreas Rottmann <a.rottmann@gmx.at> | 2011-05-27 14:48:31 +0200 |
---|---|---|
committer | Andreas Rottmann <a.rottmann@gmx.at> | 2011-05-27 14:48:31 +0200 |
commit | dfc4d56df1854e1c93606fa03497ff7218357e3d (patch) | |
tree | 81d4b370026a44909c0384270b8b2a387c993e48 | |
parent | c382f58943a80cc9467695b3f2399407bcf7e1bf (diff) | |
download | guile-dfc4d56df1854e1c93606fa03497ff7218357e3d.tar.gz |
Add some tests for the R6RS I/O libraries
* test-suite/tests/r6rs-ports.test
(call-with-bytevector-output-port/transcoded): New helper procedure.
("8.2.6 Input and output ports"): Use that helper procedure.
(encoding-error-predicate): New helper procedure.
("8.2.12 Textual Output"): Add tests for `put-char' and `put-string'
exception behavior on encoding errors.
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 7a382b75b..feef48d40 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -72,6 +72,12 @@ (lambda () #t)) ;; close-port "rw"))) +(define (call-with-bytevector-output-port/transcoded transcoder receiver) + (call-with-bytevector-output-port + (lambda (bv-port) + (call-with-port (transcoded-port bv-port transcoder) + receiver)))) + (with-test-prefix "7.2.5 End-of-File Object" @@ -620,11 +626,9 @@ (let ((s "Hello\nÄÖÜ")) (bytevector=? (string->utf8 s) - (call-with-bytevector-output-port - (lambda (bv-port) - (call-with-port (transcoded-port bv-port (make-transcoder (utf-8-codec))) - (lambda (utf8-port) - (put-string utf8-port s)))))))) + (call-with-bytevector-output-port/transcoded (make-transcoder (utf-8-codec)) + (lambda (utf8-port) + (put-string utf8-port s)))))) (pass-if "transcoded-port [input]" (let ((s "Hello\nÄÖÜ")) @@ -720,6 +724,11 @@ (pass-if-condition "get-datum" i/o-read-error? (get-datum (make-failing-port))))) +(define (encoding-error-predicate char) + (lambda (c) + (and (i/o-encoding-error? c) + (char=? char (i/o-encoding-error-char c))))) + (with-test-prefix "8.2.12 Textual Output" (with-test-prefix "write error" @@ -728,7 +737,22 @@ (pass-if-condition "put-string" i/o-write-error? (put-string (make-failing-port) "Hello World!")) (pass-if-condition "put-datum" i/o-write-error? - (put-datum (make-failing-port) '(hello world!))))) + (put-datum (make-failing-port) '(hello world!)))) + (with-test-prefix "encoding error" + (pass-if-condition "put-char" (encoding-error-predicate #\λ) + (call-with-bytevector-output-port/transcoded + (make-transcoder (latin-1-codec) + (native-eol-style) + (error-handling-mode raise)) + (lambda (port) + (put-char port #\λ)))) + (pass-if-condition "put-string" (encoding-error-predicate #\λ) + (call-with-bytevector-output-port/transcoded + (make-transcoder (latin-1-codec) + (native-eol-style) + (error-handling-mode raise)) + (lambda (port) + (put-string port "FooλBar")))))) (with-test-prefix "8.3 Simple I/O" (with-test-prefix "read error" |