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

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

Replaced values and let-values with list and match-let.

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 (+ 1 ,x)))
11(define-macro (++ x)  `(+ 1 ,x))
12(define-macro (--! x) `(set! ,x (- ,x 1)))
13(define-macro (-- x)  `(- ,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                       (* (/ max-key 2) (+ (+ 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.