Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 318 lines (285 sloc) 10.201 kb
a138029 @hargettp Renamed package, added license and README
authored
1 ;; Copyright (c) 2011 Phil Hargett
cd16522 @hargettp Initial work on red-black trees
authored
2
a138029 @hargettp Renamed package, added license and README
authored
3 ;; Permission is hereby granted, free of charge, to any person obtaining a copy
4 ;; of this software and associated documentation files (the "Software"), to deal
5 ;; in the Software without restriction, including without limitation the rights
6 ;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
7 ;; copies of the Software, and to permit persons to whom the Software is
8 ;; furnished to do so, subject to the following conditions:
9
10 ;; The above copyright notice and this permission notice shall be included in
11 ;; all copies or substantial portions of the Software.
12
13 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14 ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15 ;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16 ;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17 ;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
18 ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
19 ;; THE SOFTWARE.
20
21 (defpackage :hh-redblack-tests
22 (:use :cl :lisp-unit :hh-redblack))
23
24 (in-package :hh-redblack-tests)
cd16522 @hargettp Initial work on red-black trees
authored
25
26 (remove-all-tests)
27
28 (define-test create-rb-rtree-tests
29 (let ((tree (make-red-black-tree)))
30 (assert-true tree)
a138029 @hargettp Renamed package, added license and README
authored
31 (assert-eq :black (hh-redblack::color (hh-redblack::root tree)))
32 (assert-false (hh-redblack::rb-first tree))
33 (assert-false (hh-redblack::rb-last tree))))
cd16522 @hargettp Initial work on red-black trees
authored
34
35 (define-test create-rb-node-tests
a138029 @hargettp Renamed package, added license and README
authored
36 (let ((node (make-instance 'hh-redblack::memory-red-black-node)))
cd16522 @hargettp Initial work on red-black trees
authored
37 (assert-true node)))
38
39 (define-test put-tests
40 (let ((tree (make-red-black-tree)))
41 (rb-put tree 1 "one")
a138029 @hargettp Renamed package, added license and README
authored
42 (assert-eq :black (hh-redblack::color (hh-redblack::root tree)))
cd16522 @hargettp Initial work on red-black trees
authored
43 (assert-true t)))
44
45 (define-test put-get-tests
46 (let ((tree (make-red-black-tree)))
47 (rb-put tree 1 "one")
48 (assert-true (string= "one" (rb-get tree 1)))
49 (rb-put tree 2 "two")
50 (assert-true (string= "one" (rb-get tree 1)))
51 (assert-true (string= "two" (rb-get tree 2)))))
52
53 (define-test iteration-tests
54 (assert-equal `(1 2 3 4 5)
55 (let ((tree (make-red-black-tree))
56 (keys ()))
57 (rb-put tree 4 "four")
58 (rb-put tree 1 "one")
59 (rb-put tree 5 "five")
60 (rb-put tree 3 "three")
61 (rb-put tree 2 "two")
62 (with-rb-keys-and-data (key data :first) tree
63 (setf keys (append keys (list key))))
64 keys))
65 (assert-equal `(5 4 3 2 1)
66 (let ((tree (make-red-black-tree))
67 (keys ()))
68 (rb-put tree 4 "four")
69 (rb-put tree 1 "one")
70 (rb-put tree 5 "five")
71 (rb-put tree 3 "three")
72 (rb-put tree 2 "two")
73 (with-rb-keys-and-data (key data :last) tree
74 (setf keys (append keys (list key))))
75 keys))
76 (assert-equal `("one" "two" "three" "four" "five")
77 (let ((tree (make-red-black-tree))
78 (all-data ()))
79 (rb-put tree 4 "four")
80 (rb-put tree 1 "one")
81 (rb-put tree 5 "five")
82 (rb-put tree 3 "three")
83 (rb-put tree 2 "two")
84 (with-rb-keys-and-data (key data :first) tree
85 (setf all-data (append all-data (list data))))
86 all-data)))
87
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
88 (define-test remove-tests
89 (assert-equal `(1 2 4 5)
90 (let ((tree (make-red-black-tree))
91 (keys ()))
92 (rb-put tree 4 "four")
93 (rb-put tree 1 "one")
94 (rb-put tree 5 "five")
95 (rb-put tree 3 "three")
96 (rb-put tree 2 "two")
97 (rb-remove tree 3)
98 (with-rb-keys-and-data (key data :first) tree
99 (setf keys (append keys (list key))))
100 keys))
101
102 (let ((tree (make-red-black-tree)))
103 (rb-put tree 4 "four")
104 (rb-put tree 1 "one")
105 (rb-put tree 5 "five")
106 (rb-put tree 3 "three")
107 (rb-put tree 2 "two")
108 (assert-equal `(1 2 3 4 5)
109 (let ((keys ()))
110 (with-rb-keys-and-data (key data :first) tree
111 (setf keys (append keys (list key))))
112 keys))
113 (rb-remove tree 3)
114 (rb-remove tree 4)
115 (assert-equal `(1 2 5)
116 (let ((keys ()))
117 (with-rb-keys-and-data (key data :first) tree
118 (setf keys (append keys (list key))))
119 keys))
120 (rb-put tree 3 "three")
121 (rb-put tree 4 "four")
122 (assert-equal `(1 2 3 4 5)
123 (let ((keys ()))
124 (with-rb-keys-and-data (key data :first) tree
125 (setf keys (append keys (list key))))
126 keys))))
127
7664f6e @hargettp Fixed bad typo in macro used for testing
authored
128 (defmacro with-temporary-tree ((var) &rest body)
7a8df20 @hargettp Now use footer instead of header for root and other essential trackin…
authored
129 `(let ((temp-file-name (asdf:system-relative-pathname (asdf:find-system "hh-redblack")
130 (format nil "text-~s.tree" (random (expt 2 32))))))
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
131 (unwind-protect
132 (let ((,var (make-text-file-red-black-tree temp-file-name)))
133 ,@body)
134 (delete-file temp-file-name))))
135
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
136 (define-test peristent-red-black-tree-tests
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
137 (with-temporary-tree (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
138 (assert-true tree))
139
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
140 (with-temporary-tree (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
141 (assert-error 'requires-red-black-transaction
142 (rb-put tree 1 "one")))
143
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
144 (with-temporary-tree (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
145 (with-rb-transaction (tree)
146 (rb-put tree 1 "one"))
147 (assert-error 'requires-red-black-transaction
148 (rb-get tree 1)))
149
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
150 (with-temporary-tree (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
151 (with-rb-transaction (tree)
127884e @hargettp Additional tests
authored
152 (rb-put tree 1 "one"))
153 (with-rb-transaction (tree)
154 (rb-put tree 2 "two"))
155 (with-rb-transaction (tree)
156 (assert-equal `(1 2) (rb-keys tree))))
157
158 (with-temporary-tree (tree)
159 (with-rb-transaction (tree)
160 (rb-put tree 1 "one"))
161 (with-rb-transaction (tree)
162 (rb-put tree 2 "two"))
163 (with-rb-transaction (tree)
164 (rb-put tree 3 "two"))
165 (with-rb-transaction (tree)
166 (rb-remove tree 2))
167 (with-rb-transaction (tree)
168 (assert-equal `(1 3) (rb-keys tree))))
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
169
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
170 (with-temporary-tree (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
171 (with-rb-transaction (tree)
172 (rb-put tree 4 "four")
173 (rb-put tree 1 "one")
174 (rb-put tree 5 "five")
175 (rb-put tree 3 "three")
176 (rb-put tree 2 "two")
177 (assert-equal `(1 2 3 4 5)
178 (let ((keys ()))
179 (with-rb-keys-and-data (key data :first) tree
180 (setf keys (append keys (list key))))
181 keys))))
182
f1eaa61 @hargettp Persistent red-black tree in a text file is working; all unit tests p…
authored
183 (with-temporary-tree (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
184 (with-rb-transaction (tree)
185 (rb-put tree 4 "four")
186 (rb-put tree 1 "one")
187 (rb-put tree 5 "five")
188 (rb-put tree 3 "three")
189 (rb-put tree 2 "two")
190 (assert-equal `(1 2 3 4 5)
191 (let ((keys ()))
192 (with-rb-keys-and-data (key data :first) tree
193 (setf keys (append keys (list key))))
194 keys)))
c9f640f @hargettp Persistent red-black tree code seems to work against an in-memory vec…
authored
195
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
196 (with-rb-transaction (tree)
197 (rb-remove tree 3)
c9f640f @hargettp Persistent red-black tree code seems to work against an in-memory vec…
authored
198 (assert-equal `(1 2 4 5)
199 (let ((keys ()))
200 (with-rb-keys-and-data (key data :first) tree
201 (setf keys (append keys (list key))))
202 keys)))
203
204 (with-rb-transaction (tree)
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
205 (rb-remove tree 4)
206 (assert-equal `(1 2 5)
207 (let ((keys ()))
208 (with-rb-keys-and-data (key data :first) tree
209 (setf keys (append keys (list key))))
210 keys)))
c9f640f @hargettp Persistent red-black tree code seems to work against an in-memory vec…
authored
211
1e14ddb @hargettp Wrapping data in persistent trees in an object, and ensuring that act…
authored
212 (assert-equal `("one" "two" "three" "four" "five")
213 (with-temporary-tree (tree)
214 (with-rb-transaction (tree)
215 (let ((all-data ()))
216 (rb-put tree 4 "four")
217 (rb-put tree 1 "one")
218 (rb-put tree 5 "five")
219 (rb-put tree 3 "three")
220 (rb-put tree 2 "two")
221 (with-rb-keys-and-data (key data :first) tree
222 (setf all-data (append all-data (list (hh-redblack::contents data)))))
223 all-data))))
224
225 (assert-equal `("one" "two" "three" "four" "five")
226 (with-temporary-tree (tree)
227 (with-rb-transaction (tree)
228 (rb-put tree 4 "four")
229 (rb-put tree 1 "one")
230 (rb-put tree 5 "five")
231 (rb-put tree 3 "three")
232 (rb-put tree 2 "two")
233 (loop for key in (rb-keys tree)
234 collect (rb-get tree key)))))
235
1c8d45e @hargettp Fixed bug with 'reopening' a tree, due to not initializing the transa…
authored
236 (let ((temp-file-name (asdf:system-relative-pathname (asdf:find-system "hh-redblack")
237 (format nil "text-~s.tree" (random (expt 2 32))))))
238 (unwind-protect
239 (progn
240 (let ((tree (make-text-file-red-black-tree temp-file-name)))
241 (with-rb-transaction (tree)
242 (rb-put tree 1 "one"))
243 (with-rb-transaction (tree)
244 (assert-equal `(1) (rb-keys tree))))
245
246 (let ((tree (make-text-file-red-black-tree temp-file-name)))
247 (with-rb-transaction (tree)
248 (rb-put tree 2 "two"))
249 (with-rb-transaction (tree)
250 (assert-equal `(1 2) (rb-keys tree))))
251
252 (let ((tree (make-text-file-red-black-tree temp-file-name)))
253 (with-rb-transaction (tree)
254 (assert-equal `(1 2) (rb-keys tree)))))
255 (delete-file temp-file-name)))
256
3eb82c9 @hargettp Finished basic implementation of a persistent tree, currently backed …
authored
257 (with-rb-transaction (tree)
258 (rb-put tree 3 "three")
259 (rb-put tree 4 "four")
260 (assert-equal `(1 2 3 4 5)
261 (let ((keys ()))
262 (with-rb-keys-and-data (key data :first) tree
263 (setf keys (append keys (list key))))
264 keys)))))
265
4fa03a1 @hargettp Implemented more appropriate sorting algorithm for changes to be writ…
authored
266 (define-test larger-tree-tests
267 (let ((tree (make-red-black-tree)))
268 (rb-put tree 5 "five")
269 (rb-put tree 3 "three")
270 (rb-put tree 6 "six")
271 (rb-put tree 1 "one")
272 (rb-put tree 8 "eight")
273 (rb-put tree 2 "two")
274 (rb-put tree 9 "nine")
275 (rb-put tree 7 "seven")
276 (rb-put tree 10 "ten")
277 (rb-put tree 4 "four")
278 (rb-remove tree 3)
279 (assert-equal `(1 2 4 5 6 7 8 9 10)
280 (rb-keys tree)))
1e14ddb @hargettp Wrapping data in persistent trees in an object, and ensuring that act…
authored
281
4fa03a1 @hargettp Implemented more appropriate sorting algorithm for changes to be writ…
authored
282 (let ((tree (make-memory-persistent-red-black-tree)))
283 (with-rb-transaction (tree)
284 (rb-put tree 5 "five")
285 (rb-put tree 3 "three")
286 (rb-put tree 6 "six")
287 (rb-put tree 1 "one")
288 (rb-put tree 8 "eight")
289 (rb-put tree 2 "two")
290 (rb-put tree 9 "nine")
291 (rb-put tree 7 "seven")
292 (rb-put tree 10 "ten")
293 (rb-put tree 4 "four"))
294 (with-rb-transaction (tree)
295 (rb-remove tree 3))
296 (assert-equal `(1 2 4 5 6 7 8 9 10)
297 (with-rb-transaction (tree)
298 (rb-keys tree))))
1e14ddb @hargettp Wrapping data in persistent trees in an object, and ensuring that act…
authored
299
4fa03a1 @hargettp Implemented more appropriate sorting algorithm for changes to be writ…
authored
300 (with-temporary-tree (tree)
301 (with-rb-transaction (tree)
302 (rb-put tree 5 "five")
303 (rb-put tree 3 "three")
304 (rb-put tree 6 "six")
305 (rb-put tree 1 "one")
306 (rb-put tree 8 "eight")
307 (rb-put tree 2 "two")
308 (rb-put tree 9 "nine")
309 (rb-put tree 7 "seven")
310 (rb-put tree 10 "ten")
311 (rb-put tree 4 "four"))
312 (with-rb-transaction (tree)
313 (rb-remove tree 3))
314 (assert-equal `(1 2 4 5 6 7 8 9 10)
315 (with-rb-transaction (tree)
316 (rb-keys tree)))))
317
cd16522 @hargettp Initial work on red-black trees
authored
318 (run-tests)
Something went wrong with that request. Please try again.