From 68c197d02fd60c7607a889db93db7c2228400b0b Mon Sep 17 00:00:00 2001 From: James Swaine Date: Fri, 29 Jan 2010 21:44:46 +0000 Subject: [PATCH] added basic test suite for the parallel futures module svn: r17890 --- collects/tests/mzscheme/future.ss | 110 ++++++++++++++++++++++++++++++ 1 file changed, 110 insertions(+) create mode 100644 collects/tests/mzscheme/future.ss diff --git a/collects/tests/mzscheme/future.ss b/collects/tests/mzscheme/future.ss new file mode 100644 index 0000000000..01ba92b82e --- /dev/null +++ b/collects/tests/mzscheme/future.ss @@ -0,0 +1,110 @@ +(load-relative "loadtest.ss") + +(Section 'future) +(require scheme/future) + +;; ---------------------------------------- + +(test 2 + touch + (future (λ () + 2))) + +(let ([f1 (future (λ () (+ 2 2)))] + [f2 (future (λ () (+ 5 3)))]) + (test 12 + (touch f2) (touch f1))) + +(let* ([v 5] + [f1 (future (λ () + (set! v 10) + v))]) + (test 10 touch f1)) + +(define (build-rand-list lst len) + (case len + [(0) lst] + [else + (build-rand-list (cons + (random) + lst) + (- len 1))])) + +(define (append-list-of-lists acc lst) + (cond + [(empty? lst) acc] + [else + (append-list-of-lists + (append acc (first lst)) + (rest lst))])) + +(let* ([nums '()] + [f1 (future (λ () + (build-rand-list nums 10)))]) + (set! nums (touch f1)) + (test 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)) + +(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))))) + +(test 31 'test8 + (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))))) + +(define (sum-to acc limit) + (case limit + [(0) acc] + [else + (sum-to (+ acc limit) (- limit 1))])) + +(test 600030000 'test10 + (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) + + + + + + + + + + + + +