source: project/release/4/rb-tree/trunk/tests/run.scm @ 14465

Last change on this file since 14465 was 14465, checked in by Ivan Raikov, 10 years ago

treap and rb-tree copied to release/4 branch and ported to Chicken 4

File size: 2.6 KB
Line 
1
2;;
3;; Verifying the rb-tree package
4;;
5
6(require-library srfi-1 srfi-13 rb-tree test)
7(import srfi-1 srfi-13 rb-tree test)
8
9(define (++ x) (fx+ 1 x))
10(define (-- x) (fx- x 1))
11
12(define min-key 1) 
13(define max-key 100)
14           
15(define rb-tree (make-rb-tree (lambda (x y) (- x y))))
16       
17;; a hard-wired association between a key and a value"   
18(define compute-assoc (lambda (key) (cons key (++ key))))
19           
20(test-group "rb-tree-test initial"
21
22            (test-assert (rb-tree 'empty?))
23            (test-assert (zero? (rb-tree 'size))))
24
25(test-group (string-concatenate (list "loading a sequence [" 
26                                      (number->string min-key) ", " 
27                                      (number->string max-key) "] in ascending order"))
28
29    (do ((i min-key (++ i))) ((> i max-key))
30      (test-assert (not ((rb-tree 'put!) i (cdr (compute-assoc i)))))
31      (test (compute-assoc i)((rb-tree 'get) i) ))
32
33     (test (rb-tree 'size) (++ (- max-key min-key)))
34     (test-assert (not (rb-tree 'empty?)))
35           
36     (test (compute-assoc (++ min-key)) ((rb-tree 'get) (++ min-key)) )
37     (test (compute-assoc (++ min-key)) ((rb-tree 'get) (++ min-key) #f)  )
38           
39     (test-assert "check looking up of non-existing keys" 
40                  (not ((rb-tree 'get) (-- min-key) #f)))
41           
42     (rb-tree 'clear!)
43     )
44
45(test-group "reloading the same seq in descending order and then deleting" 
46           
47    (test-assert (rb-tree 'empty?))
48    (test-assert (zero? (rb-tree 'size)))
49           
50    (do ((i max-key (-- i))) ((< i min-key))
51      (test-assert (not ((rb-tree 'put!) i (cdr (compute-assoc i)))))
52      (test  (compute-assoc i) ((rb-tree 'get) i))
53      (test-assert ((rb-tree 'delete!) i))))
54
55(test-group "loading the rb-tree again in a \"random\" order" 
56
57     (test-assert (zero? (rb-tree 'size)))
58           
59     (do ((i min-key) (j max-key) (direction #t (not direction)))
60         ((< j i))
61       (cond
62        (direction
63         (test-assert (not ((rb-tree 'put!) i (cdr (compute-assoc i)))))
64         (set! i (++ i)))
65        (else
66         (test-assert (not ((rb-tree 'put!) j (cdr (compute-assoc j)))))
67         (set! j (-- j))))))
68   
69(test-group "looking up the elements in  the rb-tree" 
70    (do ((i min-key (++ i))) ((> i max-key))
71            (test (compute-assoc i) ((rb-tree 'get) i) )))
72
73(test "using fold to sum the elements in the rb-tree" 
74      (* 50 (+ (+ 1 min-key) (+ 1 max-key)))
75      ((rb-tree 'fold) (lambda (x sum) (+ x sum)) 0))
76
77(test-group "using 'map to create a copy of tree with each element x mapped to x*10"
78    (let ((rb-tree-x10 ((rb-tree 'map) (lambda (x) (* x 10))))
79          (compute-assoc-x10 (lambda (key) (cons key (* 10 (++ key))))))
80      (do ((i min-key (++ i))) ((> i max-key))
81        (test (compute-assoc-x10 i) ((rb-tree-x10 'get) i) ))))
82
Note: See TracBrowser for help on using the repository browser.