mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00
Code Activity

Add some tests for the R6RS I/O libraries

Browse source 
* 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.
This commit is contained in:
Andreas Rottmann 2011-05-27 14:48:31 +02:00
parent c382f58943
commit dfc4d56df1
1 changed files with 30 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -72,6 +72,12 @@
(lambda () #t)) ;; close-port (lambda () #t)) ;; close-port
"rw"))) "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" (with-test-prefix "7.2.5 End-of-File Object"
@ -620,11 +626,9 @@
(let ((s "Hello\nÄÖÜ")) (let ((s "Hello\nÄÖÜ"))
(bytevector=? (bytevector=?
(string->utf8 s) (string->utf8 s)
(call-with-bytevector-output-port (call-with-bytevector-output-port/transcoded (make-transcoder (utf-8-codec))
(lambda (bv-port) (lambda (utf8-port)
(call-with-port (transcoded-port bv-port (make-transcoder (utf-8-codec))) (put-string utf8-port s))))))
(lambda (utf8-port)
(put-string utf8-port s))))))))
(pass-if "transcoded-port [input]" (pass-if "transcoded-port [input]"
(let ((s "Hello\nÄÖÜ")) (let ((s "Hello\nÄÖÜ"))
@ -720,6 +724,11 @@
(pass-if-condition "get-datum" i/o-read-error? (pass-if-condition "get-datum" i/o-read-error?
(get-datum (make-failing-port))))) (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 "8.2.12 Textual Output"
(with-test-prefix "write error" (with-test-prefix "write error"
@ -728,7 +737,22 @@
(pass-if-condition "put-string" i/o-write-error? (pass-if-condition "put-string" i/o-write-error?
(put-string (make-failing-port) "Hello World!")) (put-string (make-failing-port) "Hello World!"))
(pass-if-condition "put-datum" i/o-write-error? (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 "8.3 Simple I/O"
(with-test-prefix "read error" (with-test-prefix "read error"