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

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

Browse Source 
svn: r18341
This commit is contained in:
Robby Findler 2010-02-25 21:32:48 +00:00
parent 39dd21c240
commit ca8459a3a0
1 changed files with 49 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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