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

use function for fx/carry tests

Browse Source 
svn: r10881
This commit is contained in:
Matthew Flatt 2008-07-23 16:18:47 +00:00
parent ea3c3687dc
commit 84003497a0
2 changed files with 32 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/tests/r6rs/arithmetic/fixnums.sls
View File

@ -28,21 +28,23 @@
(define-syntax carry-test
(syntax-rules ()
[(_ fxop/carry fxop/carry-reference fx1 fx2 fx3)
(test (vals->list fxop/carry fx1 fx2 fx3)
(vals->list fxop/carry-reference fx1 fx2 fx3))]))
(run-test `(fxop/carry ,fx1 ,fx2 ,fx3)
(vals->list fxop/carry fx1 fx2 fx3)
(vals->list fxop/carry-reference fx1 fx2 fx3))]))
(define-syntax carry-tests
(syntax-rules ()
[(_ 0 nums)
(carry-tests 0 nums nums nums)]
[(_ 0 (n ...) ms ps)
(begin (carry-tests 1 n ms ps) ...)]
[(_ 1 n (m ...) ps)
(begin (carry-tests 2 n m ps) ...)]
[(_ 2 n m (p ...))
(begin (carry-test fx*/carry fx*/carry-reference n m p) ...
(carry-test fx+/carry fx+/carry-reference n m p) ...
(carry-test fx-/carry fx-/carry-reference n m p) ...)]))
(define (carry-tests l)
(for-each
(lambda (n)
(for-each
(lambda (m)
(for-each
(lambda (p)
(carry-test fx*/carry fx*/carry-reference n m p)
(carry-test fx+/carry fx+/carry-reference n m p)
(carry-test fx-/carry fx-/carry-reference n m p))
l))
l))
l))
(define (run-arithmetic-fixnums-tests)
@ -186,8 +188,9 @@
(test (fx- (greatest-fixnum) (greatest-fixnum)) 0)
(test (fx- (least-fixnum) (least-fixnum)) 0)
;; If you put N numbers here, it expands to O(N^3) tests!
(carry-tests 0 [0 1 2 -1 -2 38734 -3843 2484598 -348732487 (greatest-fixnum) (least-fixnum)])
;; If you put N numbers here, it runs to O(N^3) tests!
(carry-tests (list 0 1 2 -1 -2 38734 -3843 2484598 -348732487
(greatest-fixnum) (least-fixnum)))
(test (fxdiv 123 10) 12)
(test (fxmod 123 10) 3)

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

@ -9,6 +9,7 @@
test/unspec
test/unspec-or-exn
test/output/unspec
run-test
report-test-results)
(import (rnrs))
@ -23,9 +24,9 @@
[(_ expr expected)
(begin
;; (write 'expr) (newline)
(check-test 'expr
(catch-exns (lambda () expr))
expected))]))
(run-test 'expr
(catch-exns (lambda () expr))
expected))]))
(define (catch-exns thunk)
(guard (c [#t (make-err c)])
@ -60,14 +61,14 @@
(define-syntax test/output
(syntax-rules ()
[(_ expr expected str)
(check-test 'expr
(capture-output
(lambda ()
(check-test 'expr
(guard (c [#t (make-err c)])
expr)
expected)))
str)]))
(run-test 'expr
(capture-output
(lambda ()
(run-test 'expr
(guard (c [#t (make-err c)])
expr)
expected)))
str)]))
(define-syntax test/unspec
(syntax-rules ()
@ -105,7 +106,7 @@
(if (file-exists? "tmp-catch-out")
(delete-file "tmp-catch-out")))))
(define (check-test expr got expected)
(define (run-test expr got expected)
(set! checked (+ 1 checked))
(unless (if (and (real? expected)
(nan? expected))