source: project/binary-tree/tests/binary-tree-test.scm @ 5064

Last change on this file since 5064 was 5064, checked in by Kon Lovett, 13 years ago

Changed to chicken-setup tests directory structure.

File size: 3.5 KB
Line 
1;;;; binary-tree-test.scm
2
3(use testbase testbase-output-human)
4(use avltree)
5(use srfi-1 srfi-13)
6
7;;
8
9(define-inline (->boolean obj)
10        (not (not obj)) )
11
12(define (random-alist n #!optional (lim (* n 10)))
13        (let loop ([n n] [al '()])
14                (if (zero? n)
15                        al
16                        (loop (sub1 n) (alist-cons (random lim) (gensym) al)) ) ) )
17
18(define (alist-same? al1 al2)
19        (every
20                (lambda (pair)
21                        (and-let* ([v2 (alist-ref (car pair) al2 equal?)])
22                                (equal? v2 (cdr pair)) ) )
23                al1) )
24
25(define-expect-binary alist-same? alist-same "alist same key-value pairs, w/o ordering")
26
27(define (list-same? l1 l2)
28        (every (lambda (x) (->boolean (member x l2))) l1) )
29
30(define-expect-binary list-same? list-same "list same values, w/o ordering")
31
32(define (random-tree n)
33        (alist->avltree (random-alist n) <) )
34
35;;
36
37(define-test avltree-test "Avl-Tree"
38  (initial
39                (define t1 #f) )
40
41        (expect-set! t1
42                (alist->avltree
43                        '(("phone" . 3456) ("fax" . 2345) ("name" . "foo") ("address" . "23 Marylane Ave"))
44                        string<))
45
46        (test/case "Avl-Tree Basic"
47
48                (expect-true (avltree? t1))
49                (expect-false (avltree? 23))
50
51                (expect-false (avltree-empty? t1))
52                (expect-eqv 4 (avltree-size t1))
53
54                (expect-true (avltree-exists? t1 "name"))
55                (expect-false (avltree-exists? t1 "foo"))
56
57                (expect-eqv 2345 (avltree-ref t1 "fax"))
58                (expect-false (avltree-ref/default t1 "foo" #f))
59                (expect-failure (avltree-ref t1 "foo"))
60
61                (expect-alist-same
62                        '(("phone" . 3456) ("fax" . 2345) ("name" . "foo") ("address" . "23 Marylane Ave"))
63                        (avltree->alist t1))
64
65                (expect-list-same
66                        '("phone" "fax" "name" "address")
67                        (avltree-keys t1))
68                (expect-list-same
69                        '(3456 2345 "foo" "23 Marylane Ave")
70                        (avltree-values t1))
71        )
72
73        (test/case "Avl-Tree Delete" (
74                        [t2 #f] )
75
76                (expect-false (avltree-delete! t1 "foo"))
77                (expect-success (avltree-delete! t1 "name"))
78                (expect-eqv 3 (avltree-size t1))
79                (expect-failure (avltree-ref t1 "name"))
80                (expect-failure (avltree-update! t1 "name" (lambda (v) v)))
81
82                (expect-set! t2 (avltree-delete t1 "fax"))
83                (expect-eqv 2 (avltree-size t2))
84                (expect-eqv 3 (avltree-size t1))
85                (expect-failure (avltree-ref t2 "fax"))
86                (expect-failure (avltree-update t2 "fax" (lambda (v) v)))
87
88                (expect-set! t2 (avltree-set t2 "name" "bar"))
89                (expect-eqv 3 (avltree-size t2))
90                (expect-equal "bar" (avltree-ref t2 "name"))
91                (expect-set! t2 (avltree-update t2 "name" (lambda (v) "baz")))
92                (expect-equal "baz" (avltree-ref t2 "name"))
93                (expect-eqv 3 (avltree-size t2))
94
95                (expect-success (avltree-set! t1 "name" "bar"))
96                (expect-eqv 4 (avltree-size t1))
97                (expect-equal "bar" (avltree-ref t1 "name"))
98                (expect-success (avltree-update! t1 "name" (lambda (v) "baz")))
99                (expect-equal "baz" (avltree-ref t1 "name"))
100                (expect-eqv 4 (avltree-size t1))
101
102                (expect-success (avltree-delete! t1 "fax"))
103                (expect-success (avltree-vacuum! t1))
104                (expect-eqv 3 (avltree-size t1))
105                (expect-alist-same
106                        '(("phone" . 3456) ("name" . "baz") ("address" . "23 Marylane Ave"))
107                        (avltree->alist t1))
108
109                (expect-set! t2 (avltree-copy t2))
110                (expect-eqv 3 (avltree-size t2))
111                (expect-alist-same
112                        '(("phone" . 3456) ("name" . "baz") ("address" . "23 Marylane Ave"))
113                        (avltree->alist t1))
114
115                (expect-success (avltree-delete! t1 "phone"))
116                (expect-success (avltree-delete! t1 "name"))
117                (expect-success (avltree-delete! t1 "address"))
118                (expect-eqv 0 (avltree-size t1))
119                (expect-alist-same
120                        '()
121                        (avltree->alist t1))
122                (expect-success (avltree-vacuum! t1))
123                (expect-eqv 0 (avltree-size t1))
124                (expect-alist-same
125                        '()
126                        (avltree->alist t1))
127        )
128)
129
130(test::styler-set! avltree-test test::output-style-human)
131(run-test "AVL Tree Tests")
Note: See TracBrowser for help on using the repository browser.