source: project/rb-tree/trunk/tests/run.scm @ 5343

Last change on this file since 5343 was 5343, checked in by Ivan Raikov, 12 years ago

Changes to make the API consistent with the documentation, and improvements to the test cases.

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