suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

R6RS test suite corrections from Kent

Browse Source 
svn: r12688
This commit is contained in:
Matthew Flatt 2008-12-03 19:47:29 +00:00
parent ba00b59ddc
commit 1f2ebbb58e
4 changed files with 48 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/r6rs/base.sls
View File

@ -62,11 +62,11 @@
(syntax-rules () (syntax-rules ()
[(_ op) [(_ op)
(begin (begin
(test/exn (op 1 0) &assertion) (test/unspec-flonum-or-exn (op 1 0) &assertion)
(test/exn (op 1 0.0) &assertion) (test/unspec-flonum-or-exn (op 1 0.0) &assertion)
(test/exn (op +inf.0 1) &assertion) (test/unspec-flonum-or-exn (op +inf.0 1) &assertion)
(test/exn (op -inf.0 1) &assertion) (test/unspec-flonum-or-exn (op -inf.0 1) &assertion)
(test/exn (op +nan.0 1) &assertion))])) (test/unspec-flonum-or-exn (op +nan.0 1) &assertion))]))
(define-syntax test-string-to-number (define-syntax test-string-to-number
(syntax-rules () (syntax-rules ()
@ -924,7 +924,7 @@
(for-each (for-each
(lambda (n) (lambda (n)
(test (string->number (number->string n)) n) (test (string->number (number->string n)) n)
(test (string->number (number->string n 10 5)) n) (test (string->number (number->string (inexact n) 10 5)) (inexact n))
(when (exact? n) (when (exact? n)
(test (string->number (number->string n 16) 16) n) (test (string->number (number->string n 16) 16) n)
(test (string->number (string-append "#x" (number->string n 16))) n) (test (string->number (string-append "#x" (number->string n 16))) n)

49
collects/tests/r6rs/io/ports.sls
View File

@ -342,16 +342,15 @@
(close-port p)) (close-port p))
(let ([p (open-file-input-port "io-tmp1")]) (let ([p (open-file-input-port "io-tmp1")])
(let ([b1 (get-u8 p)]) (let ([b1 (get-u8 p)])
(if (= b1 #xFE) (cond
(begin [(equal? b1 #xFE)
(test (get-u8 p) #xFF) (test (get-u8 p) #xFF)
(test (get-u8 p) 0) (test (get-u8 p) 0)
(test (get-u8 p) 97)) (test (get-u8 p) 97)]
(begin [(equal? b1 #xFF)
(test b1 #xFF) (test (get-u8 p) #xFE)
(test (get-u8 p) #xFE) (test (get-u8 p) 97)
(test (get-u8 p) 97) (test (get-u8 p) 0)]))
(test (get-u8 p) 0))))
(test/unspec (close-port p))) (test/unspec (close-port p)))
(let ([bytevector->string-via-file (let ([bytevector->string-via-file
@ -566,20 +565,24 @@
(lambda () pos) (lambda () pos)
(lambda (p) (set! pos p)) (lambda (p) (set! pos p))
(lambda () 'ok))]) (lambda () 'ok))])
(test (port-position p) 0) (test/unspec (port-position p))
(test (get-string-n p 3) "abc") (test (get-string-n p 3) "abc")
(test (port-position p) 3) (let ([pos3 (port-position p)])
(test (lookahead-char p) #\d) (test (lookahead-char p) #\d)
(test (lookahead-char p) #\d) (test (lookahead-char p) #\d)
(test (port-position p) 3) (test (port-position p) pos3)
(test/unspec (set-port-position! p 10)) (test (get-string-n p 7) "defghij")
(get-string-n p 2) (let ([pos10 (port-position p)])
(test (get-string-n p 2) "mn") (get-string-n p 2)
(test (get-string-n p 2) "op") (test (get-string-n p 2) "mn")
(test (get-string-n p 2) (eof-object)) (test/unspec (set-port-position! p pos10))
(test/unspec (set-port-position! p 2)) (get-string-n p 2)
(test (get-string-n p 3) "cde") (test (get-string-n p 2) "mn"))
(test/unspec (close-port p))) (test (get-string-n p 2) "op")
(test (get-string-n p 2) (eof-object))
(test/unspec (set-port-position! p pos3))
(test (get-string-n p 3) "def")
(test/unspec (close-port p))))
(test-positions make-custom-textual-input-port) (test-positions make-custom-textual-input-port)

4
collects/tests/r6rs/lists.sls
View File

@ -15,7 +15,7 @@
(test (for-all even? '()) #t) (test (for-all even? '()) #t)
(test (for-all even? '(3 1 4 1 5 9)) #f) (test (for-all even? '(3 1 4 1 5 9)) #f)
(test (for-all even? '(3 1 4 1 5 9 . 2)) #f) ;; (test (for-all even? '(3 1 4 1 5 9 . 2)) #f) ; removed from R6RS
(test (for-all even? '(2 4 14)) #t) (test (for-all even? '(2 4 14)) #t)
(test/exn (for-all even? '(2 4 14 . 9)) &assertion) (test/exn (for-all even? '(2 4 14 . 9)) &assertion)
(test (for-all (lambda (n) (and (even? n) n)) (test (for-all (lambda (n) (and (even? n) n))
@ -121,7 +121,7 @@
(test (for-all (lambda (x) x) '(12 14)) 14) (test (for-all (lambda (x) x) '(12 14)) 14)
(test (for-all (lambda (x) x) '(12)) 12) (test (for-all (lambda (x) x) '(12)) 12)
(test (for-all (lambda (x) x) '()) #t) (test (for-all (lambda (x) x) '()) #t)
(test (for-all even? '(13 . 14)) #f) ;; (test (for-all even? '(13 . 14)) #f) ; removed from R6RS
(test (for-all cons '(1 2 3) '(a b c)) '(3 . c)) (test (for-all cons '(1 2 3) '(a b c)) '(3 . c))
(test (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f) (test (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f)
;; R6RS merely says that this *should* work, but not must: ;; R6RS merely says that this *should* work, but not must:

14
collects/tests/r6rs/test.sls
View File

@ -9,6 +9,7 @@
test/output test/output
test/unspec test/unspec
test/unspec-or-exn test/unspec-or-exn
test/unspec-flonum-or-exn
test/output/unspec test/output/unspec
run-test run-test
report-test-results) report-test-results)
@ -123,6 +124,19 @@
(begin expr 'unspec)) (begin expr 'unspec))
'unspec)])) 'unspec)]))
(define-syntax test/unspec-flonum-or-exn
(syntax-rules ()
[(_ expr condition)
(test (guard (c [((condition-predicate (record-type-descriptor condition)) c)
'unspec-or-flonum])
(let ([v expr])
(if (flonum? v)
'unspec-or-flonum
(if (eq? v 'unspec-or-flonum)
(list v)
v))))
'unspec-or-flonum)]))
(define-syntax test/output/unspec (define-syntax test/output/unspec
(syntax-rules () (syntax-rules ()
[(_ expr str) [(_ expr str)