changed to schemeunit so the tests can be in a module and so we dont see random values in the printed output

svn: r18341
This commit is contained in:
Robby Findler 2010-02-25 21:32:48 +00:00
parent 39dd21c240
commit ca8459a3a0

View File

@ -1,7 +1,7 @@
(load-relative "../mzscheme/loadtest.ss")
#lang scheme/base
(Section 'future)
(require scheme/future)
(require scheme/future
schemeunit)
#|Need to add expressions which raise exceptions inside a
future thunk which can be caught at the touch site
@ -15,20 +15,18 @@ We should also test deep continuations.
;; ----------------------------------------
(test 2
touch
(future (λ ()
2)))
(check-equal? 2
(touch (future (λ () 2))))
(let ([f1 (future (λ () (+ 2 2)))]
[f2 (future (λ () (+ 5 3)))])
(test 12 + (touch f2) (touch f1)))
[f2 (future (λ () (+ 5 3)))])
(check-equal? 12 (+ (touch f2) (touch f1))))
(let* ([v 5]
[f1 (future (λ ()
(set! v 10)
v))])
(test 10 touch f1))
[f1 (future (λ ()
(set! v 10)
v))])
(check-equal? 10 (touch f1)))
(define (build-rand-list lst len)
(case len
@ -41,45 +39,45 @@ We should also test deep continuations.
(define (append-list-of-lists acc lst)
(cond
[(empty? lst) acc]
[(null? lst) acc]
[else
(append-list-of-lists
(append acc (first lst))
(rest lst))]))
(append acc (car lst))
(cdr lst))]))
(let* ([nums '()]
[f1 (future (λ ()
(build-rand-list nums 10)))])
(build-rand-list nums 10)))])
(set! nums (touch f1))
(test 20 length (touch (future (λ ()
(build-rand-list nums 10))))))
(check-equal? 20 (length (touch (future (λ () (build-rand-list nums 10)))))))
(let* ([f1 (future (λ ()
(build-rand-list '() 20)))]
[f2 (future (λ () (length (touch f1))))])
(test 20 touch f2))
(check-equal? 20 (touch f2)))
(test 50000 'test7
(let ([fts (for/list ([i (in-range 0 10000)])
(future (λ () (build-rand-list '() 5))))])
(length (append-list-of-lists '() (map touch fts)))))
(check-equal? 50000
(let ([fts (for/list ([i (in-range 0 10000)])
(future (λ () (build-rand-list '() 5))))])
(length (append-list-of-lists '() (map touch fts)))))
(test 31 'test8
(let* ([f1 (future (λ () (foldl + 0 '(1 2 3 4 5))))]
[f2 (future (λ () (+ (touch
(future (λ ()
(+ 6
(touch f1)))))
10)))])
(touch f2)))
(check-equal? 31
(let* ([f1 (future (λ () (foldl + 0 '(1 2 3 4 5))))]
[f2 (future (λ () (+ (touch
(future (λ ()
(+ 6
(touch f1)))))
10)))])
(touch f2)))
(test 30000 'test9
(let ([fts (for/list ([i (in-range 0 100)])
(future (λ ()
(build-rand-list '() 300))))])
(collect-garbage)
(collect-garbage)
(length (append-list-of-lists '() (map touch fts)))))
(check-equal? 30000
(let ([fts (for/list ([i (in-range 0 100)])
(future (λ ()
(build-rand-list '() 300))))])
(collect-garbage)
(collect-garbage)
(length (append-list-of-lists '() (map touch fts)))))
(define (sum-to acc limit)
(case limit
@ -87,24 +85,23 @@ We should also test deep continuations.
[else
(sum-to (+ acc limit) (- limit 1))]))
(test 600030000 'test10
(check-equal?
600030000
(let ([f1 (future (λ () (sum-to 0 20000)))]
[f2 (future (λ () (sum-to 0 20000)))]
[f3 (future (λ () (sum-to 0 20000)))])
(+ (+ (touch f3) (touch f1)) (touch f2))))
(test #t 'test11
(let* ( [f1 (future (λ () (build-rand-list '() 10000)))]
[f2 (future (λ ()
(foldl (λ (a b)
(* a b))
1
(touch f1))))]
[f3 (future (λ () (< (touch f2) 1)))])
(touch f3)))
(report-errs)
(check-equal?
#t
(let* ( [f1 (future (λ () (build-rand-list '() 10000)))]
[f2 (future (λ ()
(foldl (λ (a b)
(* a b))
1
(touch f1))))]
[f3 (future (λ () (< (touch f2) 1)))])
(touch f3)))