dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rewrite port decoding error tests using a mini DSL.

Browse source 
* test-suite/tests/ports.test ("string ports")[test-decoding-error]: New
  macro.
  ["read-char, wrong encoding, error", "read-char, wrong encoding,
  escape", "read-char, wrong encoding, substitute", "peek-char, wrong
  encoding, error"]: Rewrite using `test-decoding-error'.
This commit is contained in:
Ludovic Courtès 2011-04-27 16:28:29 +02:00
commit 9a201881e6
1 changed files with 71 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

139
test-suite/tests/ports.test
View file

@ -462,80 +462,79 @@
(= (port-line p) 0)
(= (port-column p) 0))))
(pass-if "read-char, wrong encoding, error"
(let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
(catch 'decoding-error
(lambda ()
(set-port-encoding! p "UTF-8")
(set-port-conversion-strategy! p 'error)
(read-char p)
#f)
(lambda (key subr message err port)
(and (eq? port p)
;; Mini DSL to test decoding error handling.
(letrec-syntax ((decoding-error?
(syntax-rules ()
((_ port exp)
(catch 'decoding-error
(lambda ()
(pk 'exp exp)
#f)
(lambda (key subr message errno p)
(and (eq? p port)
(not (= 0 errno))))))))
(make-check
(syntax-rules (-> error eof)
((_ port (proc -> error))
(decoding-error? port (proc port)))
((_ port (proc -> eof))
(eof-object? (proc port)))
((_ port (proc -> char))
(eq? (proc port) char))))
(make-checks
(syntax-rules ()
((_ port check ...)
(and (make-check port check) ...))))
(test-decoding-error
(syntax-rules (tests)
((_ sequence encoding strategy (tests checks ...))
(pass-if (format #f "test-decoding-error: ~s ~s ~s ~s"
(caar '(checks ...))
'sequence encoding strategy)
(let ((p (open-bytevector-input-port
(u8-list->bytevector 'sequence))))
(set-port-encoding! p encoding)
(set-port-conversion-strategy! p strategy)
(make-checks p checks ...)))))))
;; PORT should point past the error.
(equal? '(#\A #\B #\C)
(list (read-char port)
(read-char port)
(read-char port)))
(test-decoding-error (255 65 66 67) "UTF-8" 'error
(tests
(read-char -> error)
(read-char -> #\A)
(read-char -> #\B)
(read-char -> #\C)
(read-char -> eof)))
(eof-object? (read-char port)))))))
(test-decoding-error (255 65 66 67) "UTF-8" 'escape
;; `escape' should behave exactly like `error'.
(tests
(read-char -> error)
(read-char -> #\A)
(read-char -> #\B)
(read-char -> #\C)
(read-char -> eof)))
(pass-if "read-char, wrong encoding, escape"
;; `escape' should behave exactly like `error'.
(let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
(catch 'decoding-error
(lambda ()
(set-port-encoding! p "UTF-8")
(set-port-conversion-strategy! p 'escape)
(read-char p)
#f)
(lambda (key subr message err port)
(and (eq? port p)
(test-decoding-error (255 206 187 206 188) "UTF-8" 'substitute
(tests
(read-char -> #\?)
(read-char -> #\λ)
(read-char -> #\μ)
(read-char -> eof)))
;; PORT should point past the error.
(equal? '(#\A #\B #\C)
(list (read-char port)
(read-char port)
(read-char port)))
(test-decoding-error (255 65 66 67) "UTF-8" 'error
(tests
;; `peek-char' should repeatedly raise an error.
(peek-char -> error)
(peek-char -> error)
(peek-char -> error)
(eof-object? (read-char port)))))))
;; Move past the error.
(read-char -> error)
(pass-if "read-char, wrong encoding, substitute"
(let ((p (open-bytevector-input-port #vu8(255 206 187 206 188))))
(set-port-encoding! p "UTF-8")
(set-port-conversion-strategy! p 'substitute)
(equal? (list (read-char p) (read-char p) (read-char p))
'(#\? #\λ #\μ))))
(pass-if "peek-char, wrong encoding, error"
(let-syntax ((decoding-error?
(syntax-rules ()
((_ port exp)
(catch 'decoding-error
(lambda ()
(pk 'exp exp)
#f)
(lambda (key subr message errno p)
(eq? p port)))))))
(let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
(set-port-encoding! p "UTF-8")
(set-port-conversion-strategy! p 'error)
;; `peek-char' should repeatedly raise an error.
(and (decoding-error? p (peek-char p))
(decoding-error? p (peek-char p))
(decoding-error? p (peek-char p))
;; Move past the error.
(decoding-error? p (read-char p))
;; Finish happily.
(equal? '(#\A #\B #\C)
(list (read-char p)
(read-char p)
(read-char p)))
(eof-object? (read-char p)))))))
(read-char -> #\A)
(read-char -> #\B)
(read-char -> #\C)
(read-char -> eof)))))
(with-test-prefix "call-with-output-string"
@ -994,3 +993,7 @@
'("read" "read-char" "read-line")))
(delete-file (test-file))
;;; Local Variables:
;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
;;; End: