mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-27 21:40:34 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source
This commit is contained in:
Andy Wingo 2011-05-05 14:09:29 +02:00
commit 891a1851a1
41 changed files with 1177 additions and 705 deletions
Download patch file Download diff file Expand all files Collapse all files

14
test-suite/tests/asm-to-bytecode.test
View file

@ -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)))))

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

@ -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)))
(error ;; C0: should be in the C2..DF range
error ;; 80: invalid
#\A
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)))
(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"