diff options
author | Andy Wingo <wingo@pobox.com> | 2011-05-05 14:09:29 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-05-05 14:09:29 +0200 |
commit | 891a1851a1e0e47560cf99cf76e9478d77e1a7db (patch) | |
tree | 8d00ba1b7f14b75005285d86abba3ea05b4f1767 /test-suite/tests | |
parent | 1903eae4c9ab97b575dad4ab1f5cf05436d84ab3 (diff) | |
parent | eae2438d2bd1d9a0e0aaa052abb8b36b2d073850 (diff) | |
download | guile-891a1851a1e0e47560cf99cf76e9478d77e1a7db.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Diffstat (limited to 'test-suite/tests')
-rw-r--r-- | test-suite/tests/asm-to-bytecode.test | 14 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 134 |
2 files changed, 72 insertions, 76 deletions
diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test index 0d8fecb5a..049e4b2fd 100644 --- a/test-suite/tests/asm-to-bytecode.test +++ b/test-suite/tests/asm-to-bytecode.test @@ -19,11 +19,9 @@ #:use-module ((rnrs io ports) #:select (open-bytevector-output-port)) #:use-module (test-suite lib) #:use-module (system vm instruction) + #:use-module (language assembly) #:use-module (language assembly compile-bytecode)) -(define write-bytecode - (@@ (language assembly compile-bytecode) write-bytecode)) - (define (->u8-list sym val) (let ((entry (assq-ref `((uint16 2 ,bytevector-u16-native-set!) (uint32 4 ,bytevector-u32-native-set!)) @@ -54,11 +52,11 @@ (run-test `(length ,x) #t (lambda () - (call-with-values open-bytevector-output-port - (lambda (port get-bytevector) - (write-bytecode x port '() 0 #t) - (set! v (get-bytevector)) - (= (bytevector-length v) len))))) + (let* ((wrapped `(load-program () ,(byte-length x) #f ,x)) + (bv (compile-bytecode wrapped '()))) + (set! v (make-bytevector (- (bytevector-length bv) 8))) + (bytevector-copy! bv 8 v 0 (bytevector-length v)) + (= (bytevector-length v) len)))) (run-test `(compile-equal? ,x ,y) #t (lambda () (equal? v y))))) diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 69e028f36..7b646a110 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -495,97 +495,95 @@ (syntax-rules () ((_ port check ...) (and (make-check port check) ...)))) + (make-peek+read-checks + (syntax-rules () + ((_ port (result ...) e1 expected ...) + (make-peek+read-checks port + (result ... + (peek-char -> e1) + (read-char -> e1)) + expected ...)) + ((_ port (result ...)) + (make-checks port result ...)) + ((_ port #f e1 expected ...) + (make-peek+read-checks port + ((peek-char -> e1) + (read-char -> e1)) + expected ...)))) (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 ...))))))) + (syntax-rules () + ((_ sequence encoding strategy (expected ...)) + (begin + (pass-if (format #f "test-decoding-error: ~s ~s ~s" + '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 + (read-char -> expected) ...))) + + ;; Generate the same test, but with one + ;; `peek-char' call before each `read-char'. + ;; Both should yield the same result. + (pass-if (format #f "test-decoding-error: ~s ~s ~s + peek-char" + '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-peek+read-checks p #f expected ...)))))))) (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))) + (error #\A #\B #\C eof)) (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))) + (error #\A #\B #\C eof)) (test-decoding-error (255 206 187 206 188) "UTF-8" 'substitute - (tests - (read-char -> #\?) - (read-char -> #\λ) - (read-char -> #\μ) - (read-char -> eof))) + (#\? #\λ #\μ eof)) (test-decoding-error (206 187 206) "UTF-8" 'error ;; Unterminated sequence. - (tests - (read-char -> #\λ) - (read-char -> error) - (read-char -> eof))) + (#\λ error eof)) (test-decoding-error (206 187 206) "UTF-8" 'substitute ;; Unterminated sequence. - (tests - (read-char -> #\λ) - (read-char -> #\?) - (read-char -> eof))) - - (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) - - ;; Move past the error. - (read-char -> error) - - (read-char -> #\A) - (read-char -> #\B) - (read-char -> #\C) - (read-char -> eof))) + (#\λ #\? eof)) ;; Check how ill-formed UTF-8 sequences are handled (see Table 3-7 ;; of the "Conformance" chapter of Unicode 6.0.0.) (test-decoding-error (#xc0 #x80 #x41) "UTF-8" 'error - (tests - (read-char -> error) ;; C0: should be in the C2..DF range - (read-char -> error) ;; 80: invalid - (read-char -> #\A) - (read-char -> eof))) - - (test-decoding-error (#xc0 #x80 #x41) "UTF-8" 'error - (tests - (read-char -> error) ;; C0: should be in the C2..DF range - (read-char -> error) ;; 80: invalid - (read-char -> #\A) - (read-char -> eof))) + (error ;; C0: should be in the C2..DF range + error ;; 80: invalid + #\A + eof)) + + (test-decoding-error (#xc0 #x80 #x41) "UTF-8" 'substitute + (#\? ;; C0: should be in the C2..DF range + #\? ;; 80: invalid + #\A + eof)) + + (test-decoding-error (#xc2 #x41 #x42) "UTF-8" 'error + (error ;; 41: should be in the 80..BF range + #\B + eof)) (test-decoding-error (#xe0 #x88 #x88) "UTF-8" 'error - (tests - (read-char -> error) ;; 2nd byte should be in the A0..BF range - (read-char -> eof))) + (error ;; 2nd byte should be in the A0..BF range + eof)) + + (test-decoding-error (#xe0 #xa0 #x41 #x42) "UTF-8" 'error + (error ;; 3rd byte should be in the 80..BF range + #\B + eof)) (test-decoding-error (#xf0 #x88 #x88 #x88) "UTF-8" 'error - (tests - (read-char -> error) ;; 2nd byte should be in the 90..BF range - (read-char -> eof))))) + (error ;; 2nd byte should be in the 90..BF range + eof)))) (with-test-prefix "call-with-output-string" |