1 ;;; ase-tests.el -- Tests for ASE
2 ;; Copyright (C) 2006, 2007 Sebastian Freundt
4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 ;; This file is part of SXEmacs.
9 ;; Redistribution and use in source and binary forms, with or without
10 ;; modification, are permitted provided that the following conditions
13 ;; 1. Redistributions of source code must retain the above copyright
14 ;; notice, this list of conditions and the following disclaimer.
16 ;; 2. Redistributions in binary form must reproduce the above copyright
17 ;; notice, this list of conditions and the following disclaimer in the
18 ;; documentation and/or other materials provided with the distribution.
20 ;; 3. Neither the name of the author nor the names of any contributors
21 ;; may be used to endorse or promote products derived from this
22 ;; software without specific prior written permission.
24 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 ;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 ;;; Synched up with: Not in FSF.
39 ;; - test for conceptionally correct arithmetic
40 ;; See test-harness.el for instructions on how to run these tests.
44 (require 'test-harness)
47 (when (and (boundp 'load-file-name) (stringp load-file-name))
48 (push (file-name-directory load-file-name) load-path))
49 (require 'test-harness))))
52 (and (featurep 'modules)
53 (locate-module "ase-heap")
56 (when (featurep 'ase-heap)
57 (defun test-heaps (kind)
58 (setq h (ase-heap :kind kind))
66 ;;(ase-heap-to-list h)
67 ;;(ase-heap-to-list* h)
69 (Assert (= (ase-heap-size h) 5))
71 (Assert (= (ase-heap-size h) 6))
73 ;; pop elements off the heap slowly
74 (Assert (= (ase-heap-top h) 8))
75 (Assert (= (ase-heap-top-rank h) 8))
76 (Assert (= (ase-pop-heap h) 8))
77 (Assert (= (ase-heap-size h) 5))
79 (Assert (= (ase-heap-top h) 6))
80 (Assert (= (ase-heap-top-rank h) 6))
81 (Assert (= (ase-pop-heap h) 6))
82 (Assert (= (ase-heap-size h) 4))
84 (Assert (= (ase-heap-top h) 4))
85 (Assert (= (ase-heap-top-rank h) 4))
86 (Assert (= (ase-pop-heap h) 4))
87 (Assert (= (ase-heap-size h) 3))
89 (Assert (= (ase-heap-top h) 3))
90 (Assert (= (ase-heap-top-rank h) 3))
91 (Assert (= (ase-pop-heap h) 3))
92 (Assert (= (ase-heap-size h) 2))
94 (Assert (= (ase-heap-top h) 2))
95 (Assert (= (ase-heap-top-rank h) 2))
96 (Assert (= (ase-pop-heap h) 2))
97 (Assert (= (ase-heap-size h) 1))
99 (Assert (= (ase-heap-top h) 2))
100 (Assert (= (ase-heap-top-rank h) 2))
101 (Assert (= (ase-pop-heap h) 2))
102 (Assert (= (ase-heap-size h) 0))
104 (Assert (null (ase-heap-top h)))
105 (Assert (null (ase-heap-top-rank h)))
106 (Assert (null (ase-pop-heap h)))
107 (Assert (= (ase-heap-size h) 0))
109 (Assert (null (ase-heap-top h)))
110 (Assert (null (ase-heap-top-rank h)))
111 (Assert (null (ase-pop-heap h)))
112 (Assert (= (ase-heap-size h) 0))
114 (let* ((l '(8 7 6 5 4 3 2 1))
115 (k '(1 2 3 4 5 6 7 8)))
117 (mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
118 (Assert (= (ase-heap-size h) 8))
119 (Assert (equal (ase-heap-to-list h) l))
120 (Assert (= (ase-heap-size h) 8))
121 (Assert (equal (ase-heap-to-list* h) l))
122 (Assert (= (ase-heap-size h) 0))
124 (mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
125 (Assert (= (ase-heap-size h) 8))
126 (Assert (equal (ase-heap-to-list h) l))
127 (Assert (= (ase-heap-size h) 8))
128 (Assert (equal (ase-heap-to-list* h) l))
129 (Assert (= (ase-heap-size h) 0)))
131 (let* ((l '(8 7 6 5 4 3 2 1))
132 (k '(1 2 3 4 5 6 7 8))
133 (v [8 7 6 5 4 3 2 1]))
135 (mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
136 (Assert (= (ase-heap-size h) 8))
137 (Assert (equal (ase-heap-to-vector h) v))
138 (Assert (= (ase-heap-size h) 8))
139 (Assert (equal (ase-heap-to-vector* h) v))
140 (Assert (= (ase-heap-size h) 0))
142 (mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
143 (Assert (= (ase-heap-size h) 8))
144 (Assert (equal (ase-heap-to-vector h) v))
145 (Assert (= (ase-heap-size h) 8))
146 (Assert (equal (ase-heap-to-vector* h) v))
147 (Assert (= (ase-heap-size h) 0)))
149 (let* ((l '(8 7 6 5 4 3 2 1))
150 (k '(1 2 3 4 5 6 7 8))
151 (d (dllist 8 7 6 5 4 3 2 1)))
153 (mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
154 (Assert (= (ase-heap-size h) 8))
155 (Assert (equal (ase-heap-to-dllist h) d))
156 (Assert (= (ase-heap-size h) 8))
157 (Assert (equal (ase-heap-to-dllist* h) d))
158 (Assert (= (ase-heap-size h) 0))
160 (mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
161 (Assert (= (ase-heap-size h) 8))
162 (Assert (equal (ase-heap-to-dllist h) d))
163 (Assert (= (ase-heap-size h) 8))
164 (Assert (equal (ase-heap-to-dllist* h) d))
165 (Assert (= (ase-heap-size h) 0))))
167 ;;; testing coloured heaps
168 (defun test-coloured-heaps (kind)
169 (setq h (ase-heap :coloured t :kind kind))
171 (ase-add-heap h 2 'two)
172 (ase-add-heap h 6 'six)
173 (ase-add-heap h 4 'four)
174 (ase-add-heap h 8 'eight)
175 (ase-add-heap h 3 'three)
177 (Assert (= (ase-heap-size h) 5))
179 (Assert (= (ase-heap-size h) 6))
181 ;; pop elements off the heap slowly
182 (Assert (eq (ase-heap-top h) 'eight))
183 (Assert (= (ase-heap-top-rank h) 8))
184 (Assert (eq (ase-pop-heap h) 'eight))
185 (Assert (= (ase-heap-size h) 5))
187 (Assert (eq (ase-heap-top h) 'six))
188 (Assert (= (ase-heap-top-rank h) 6))
189 (Assert (eq (ase-pop-heap h) 'six))
190 (Assert (= (ase-heap-size h) 4))
192 (Assert (eq (ase-heap-top h) 'four))
193 (Assert (= (ase-heap-top-rank h) 4))
194 (Assert (eq (ase-pop-heap h) 'four))
195 (Assert (= (ase-heap-size h) 3))
197 (Assert (eq (ase-heap-top h) 'three))
198 (Assert (= (ase-heap-top-rank h) 3))
199 (Assert (eq (ase-pop-heap h) 'three))
200 (Assert (= (ase-heap-size h) 2))
203 (Assert (= (ase-heap-size h) 1))
206 (Assert (= (ase-heap-size h) 0))
208 (Assert (null (ase-heap-top h)))
209 (Assert (null (ase-heap-top-rank h)))
210 (Assert (null (ase-pop-heap h)))
211 (Assert (= (ase-heap-size h) 0))
213 (Assert (null (ase-heap-top h)))
214 (Assert (null (ase-heap-top-rank h)))
215 (Assert (null (ase-pop-heap h)))
216 (Assert (= (ase-heap-size h) 0)))
218 (defun test-char-heaps (kind)
219 (setq h (ase-heap :kind kind))
248 (equal (ase-heap-to-vector* h)
249 [?z ?y ?x ?w ?v ?u ?t ?s ?r ?q ?p ?o ?n ?m
250 ?l ?k ?j ?i ?h ?g ?f ?e ?d ?c ?b ?a])))
252 (defun test-mixed-heaps (kind)
253 (setq h (ase-heap :kind kind))
254 ;;(ase-add-heap h ?a)
257 (when (featurep 'bigz)
258 (ase-add-heap h (factorial 200)))
259 (when (featurep 'bigq)
260 (ase-add-heap h 1984319/5))
261 (when (featurep 'bigfr)
262 (ase-add-heap h euler-mascheroni)
263 (ase-add-heap h euler))
264 (when (featurep 'indefinite)
265 (ase-add-heap h +infinity)
266 (ase-add-heap h -infinity))
268 (when (featurep 'indefinite)
269 (Assert (eq (ase-pop-heap h) +infinity)))
270 (when (featurep 'bigz)
271 (Assert (= (ase-pop-heap h) (factorial 200))))
272 (when (featurep 'bigq)
273 (Assert (= (ase-pop-heap h) 1984319/5)))
274 ;;(Assert (= (ase-pop-heap h) ?a))
275 (Assert (= (ase-pop-heap h) 7.5))
276 (Assert (= (ase-pop-heap h) 3))
277 (when (featurep 'bigfr)
278 (Assert (= (ase-pop-heap h) euler))
279 (Assert (= (ase-pop-heap h) euler-mascheroni)))
280 (when (featurep 'indefinite)
281 (Assert (eq (ase-pop-heap h) -infinity))))
284 (mapcar #'test-heaps '(dynamic dense weak))
285 (mapcar #'test-coloured-heaps '(dynamic dense weak))
287 (mapcar #'test-char-heaps '(dynamic dense weak))
288 (mapcar #'test-mixed-heaps '(dynamic dense weak))
290 ;; hardcore test (only for weak heaps, no?)
291 (setq h (ase-heap :kind 'weak))
294 (ase-add-heap h (random 80000)))
295 (Assert (apply #'>= (ase-heap-to-list h)))
297 (ase-add-heap h (random 80000)))
298 (Assert (apply #'>= (ase-heap-to-list* h))))
301 ;; The cool thing about heaps is that you can add whatever you want, i.e. _no_
302 ;; restrictions there. However, when you add the second element to the heap it
303 ;; has to be compared somehow. Most domains, however, thwart you here since
304 ;; they do not possess (or can't possess) a partial ordering.
306 (defun test-non-posets (kind)
307 (setq h (ase-heap :kind kind))
308 ;; lisp symbols dont form a poset
309 (Assert (ase-add-heap h 'foo))
310 ;; adding another symbol will make SXE cry
311 (Check-Error relation-error (ase-add-heap h 'bar))
312 ;; even if we add a poset object
313 (Check-Error relation-error (ase-add-heap h 0))
314 ;; however we can pop the original element we stored there
315 (Assert (eq (ase-pop-heap h) 'foo))
317 ;; same for other non-posets
318 (when (featurep 'bigg)
319 (Assert (ase-add-heap h 1+i))
320 (Check-Error relation-error (ase-add-heap h -1+i))
321 (Check-Error relation-error (ase-add-heap h 1))
322 (Assert (= (ase-pop-heap h) 1+i))))
324 ;;(mapcar #'test-non-posets '(dynamic dense weak))
326 ;; ase-heap-tests.el ends here