summaryrefslogtreecommitdiff
path: root/test-suite/tests
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-05-05 14:09:29 +0200
committerAndy Wingo <wingo@pobox.com>2011-05-05 14:09:29 +0200
commit891a1851a1e0e47560cf99cf76e9478d77e1a7db (patch)
tree8d00ba1b7f14b75005285d86abba3ea05b4f1767 /test-suite/tests
parent1903eae4c9ab97b575dad4ab1f5cf05436d84ab3 (diff)
parenteae2438d2bd1d9a0e0aaa052abb8b36b2d073850 (diff)
downloadguile-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.test14
-rw-r--r--test-suite/tests/ports.test134
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"