18 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
19 |
;;; rassoc |
;;; rassoc |
20 |
|
|
21 |
(deftest rassoc-1 |
(deftest rassoc.1 |
22 |
(rassoc nil nil) |
(rassoc nil nil) |
23 |
nil) |
nil) |
24 |
|
|
25 |
(deftest rassoc-2 |
(deftest rassoc.2 |
26 |
(rassoc nil '(nil)) |
(rassoc nil '(nil)) |
27 |
nil) |
nil) |
28 |
|
|
29 |
(deftest rassoc-3 |
(deftest rassoc.3 |
30 |
(rassoc nil (rev-assoc-list '(nil (nil . 2) (a . b)))) |
(rassoc nil (rev-assoc-list '(nil (nil . 2) (a . b)))) |
31 |
(2 . nil)) |
(2 . nil)) |
32 |
|
|
33 |
(deftest rassoc-4 |
(deftest rassoc.4 |
34 |
(rassoc nil '((a . b) (c . d))) |
(rassoc nil '((a . b) (c . d))) |
35 |
nil) |
nil) |
36 |
|
|
37 |
(deftest rassoc-5 |
(deftest rassoc.5 |
38 |
(rassoc 'a '((b . a))) |
(rassoc 'a '((b . a))) |
39 |
(b . a)) |
(b . a)) |
40 |
|
|
41 |
(deftest rassoc-6 |
(deftest rassoc.6 |
42 |
(rassoc 'a (rev-assoc-list '((:a . b) (#:a . c) (a . d) (a . e) (z . f)))) |
(rassoc 'a (rev-assoc-list '((:a . b) (#:a . c) (a . d) (a . e) (z . f)))) |
43 |
(d . a)) |
(d . a)) |
44 |
|
|
45 |
(deftest rassoc-7 |
(deftest rassoc.7 |
46 |
(let* ((x (copy-tree (rev-assoc-list '((a . b) (b . c) (c . d))))) |
(let* ((x (copy-tree (rev-assoc-list '((a . b) (b . c) (c . d))))) |
47 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
48 |
(result (rassoc 'b x))) |
(result (rassoc 'b x))) |
49 |
(and |
(and |
50 |
(eqt result (second x)) |
(eqt result (second x)) |
51 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
52 |
t) |
t) |
53 |
|
|
54 |
(deftest rassoc-8 |
(deftest rassoc.8 |
55 |
(rassoc 1 (rev-assoc-list '((0 . a) (1 . b) (2 . c)))) |
(rassoc 1 (rev-assoc-list '((0 . a) (1 . b) (2 . c)))) |
56 |
(b . 1)) |
(b . 1)) |
57 |
|
|
58 |
(deftest rassoc-9 |
(deftest rassoc.9 |
59 |
(rassoc (copy-seq "abc") |
(rassoc (copy-seq "abc") |
60 |
(rev-assoc-list '((abc . 1) ("abc" . 2) ("abc" . 3)))) |
(rev-assoc-list '((abc . 1) ("abc" . 2) ("abc" . 3)))) |
61 |
nil) |
nil) |
62 |
|
|
63 |
(deftest rassoc-10 |
(deftest rassoc.10 |
64 |
(rassoc (copy-list '(a)) |
(rassoc (copy-list '(a)) |
65 |
(copy-tree (rev-assoc-list '(((a) b) ((a) (c)))))) |
(copy-tree (rev-assoc-list '(((a) b) ((a) (c)))))) |
66 |
nil) |
nil) |
67 |
|
|
68 |
(deftest rassoc-11 |
(deftest rassoc.11 |
69 |
(let ((x (list 'a 'b))) |
(let ((x (list 'a 'b))) |
70 |
(rassoc x |
(rassoc x |
71 |
(rev-assoc-list `(((a b) c) (,x . d) (,x . e) ((a b) 1))))) |
(rev-assoc-list `(((a b) c) (,x . d) (,x . e) ((a b) 1))))) |
72 |
(d a b)) |
(d a b)) |
73 |
|
|
74 |
|
|
75 |
(deftest rassoc-12 |
(deftest rassoc.12 |
76 |
(rassoc #\e |
(rassoc #\e |
77 |
(copy-tree |
(copy-tree |
78 |
(rev-assoc-list '(("abefd" . 1) ("aevgd" . 2) ("edada" . 3)))) |
(rev-assoc-list '(("abefd" . 1) ("aevgd" . 2) ("edada" . 3)))) |
79 |
:key #'(lambda (x) (char x 1))) |
:key #'(lambda (x) (char x 1))) |
80 |
(2 . "aevgd")) |
(2 . "aevgd")) |
81 |
|
|
82 |
(deftest rassoc-13 |
(deftest rassoc.13 |
83 |
(rassoc nil |
(rassoc nil |
84 |
(copy-tree |
(copy-tree |
85 |
(rev-assoc-list |
(rev-assoc-list |
86 |
'(((a) . b) ( nil . c ) ((nil) . d)))) |
'(((a) . b) ( nil . c ) ((nil) . d)))) |
87 |
:key #'car) |
:key #'car) |
88 |
(c)) |
(c)) |
89 |
|
|
90 |
(deftest rassoc-14 |
(deftest rassoc.14 |
91 |
(rassoc (copy-seq "abc") |
(rassoc (copy-seq "abc") |
92 |
(copy-tree |
(copy-tree |
93 |
(rev-assoc-list |
(rev-assoc-list |
94 |
'((abc . 1) ("abc" . 2) ("abc" . 3)))) |
'((abc . 1) ("abc" . 2) ("abc" . 3)))) |
95 |
:test #'equal) |
:test #'equal) |
96 |
(2 . "abc")) |
(2 . "abc")) |
97 |
|
|
98 |
(deftest rassoc-15 |
(deftest rassoc.15 |
99 |
(rassoc (copy-seq "abc") |
(rassoc (copy-seq "abc") |
100 |
(copy-tree |
(copy-tree |
101 |
(rev-assoc-list |
(rev-assoc-list |
102 |
'((abc . 1) ("abc" . 2) ("abc" . 3)))) |
'((abc . 1) ("abc" . 2) ("abc" . 3)))) |
103 |
:test #'equalp) |
:test #'equalp) |
104 |
(2 . "abc")) |
(2 . "abc")) |
105 |
|
|
106 |
(deftest rassoc-16 |
(deftest rassoc.16 |
107 |
(rassoc (copy-list '(a)) |
(rassoc (copy-list '(a)) |
108 |
(copy-tree |
(copy-tree |
109 |
(rev-assoc-list '(((a) b) ((a) (c))))) |
(rev-assoc-list '(((a) b) ((a) (c))))) |
110 |
:test #'equal) |
:test #'equal) |
111 |
((b) a)) |
((b) a)) |
112 |
|
|
113 |
(deftest rassoc-17 |
(deftest rassoc.17 |
114 |
(rassoc (copy-seq "abc") |
(rassoc (copy-seq "abc") |
115 |
(copy-tree |
(copy-tree |
116 |
(rev-assoc-list |
(rev-assoc-list |
117 |
'((abc . 1) (a . a) (b . b) ("abc" . 2) ("abc" . 3)))) |
'((abc . 1) (a . a) (b . b) ("abc" . 2) ("abc" . 3)))) |
118 |
:test-not (complement #'equalp)) |
:test-not (complement #'equalp)) |
119 |
(2 . "abc")) |
(2 . "abc")) |
120 |
|
|
121 |
(deftest rassoc-18 |
(deftest rassoc.18 |
122 |
(rassoc 'a |
(rassoc 'a |
123 |
(copy-tree |
(copy-tree |
124 |
(rev-assoc-list |
(rev-assoc-list |
125 |
'((a . d)(b . c)))) |
'((a . d)(b . c)))) |
126 |
:test-not #'eq) |
:test-not #'eq) |
127 |
(c . b)) |
(c . b)) |
128 |
|
|
129 |
(deftest rassoc-19 |
(deftest rassoc.19 |
130 |
(rassoc 'a |
(rassoc 'a |
131 |
(copy-tree |
(copy-tree |
132 |
(rev-assoc-list |
(rev-assoc-list |
133 |
'((a . d)(b . c)))) |
'((a . d)(b . c)))) |
134 |
:test (complement #'eq)) |
:test (complement #'eq)) |
135 |
(c . b)) |
(c . b)) |
136 |
|
|
137 |
(deftest rassoc-20 |
(deftest rassoc.20 |
138 |
(rassoc "a" |
(rassoc "a" |
139 |
(copy-tree |
(copy-tree |
140 |
(rev-assoc-list |
(rev-assoc-list |
141 |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
142 |
:key #'(lambda (x) (and (stringp x) (string-downcase x))) |
:key #'(lambda (x) (and (stringp x) (string-downcase x))) |
143 |
:test #'equal) |
:test #'equal) |
144 |
(6 . "A")) |
(6 . "A")) |
145 |
|
|
146 |
(deftest rassoc-21 |
(deftest rassoc.21 |
147 |
(rassoc "a" |
(rassoc "a" |
148 |
(copy-tree |
(copy-tree |
149 |
(rev-assoc-list |
(rev-assoc-list |
150 |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
151 |
:key #'(lambda (x) (and (stringp x) x)) |
:key #'(lambda (x) (and (stringp x) x)) |
152 |
:test #'equal) |
:test #'equal) |
153 |
(3 . "a")) |
(3 . "a")) |
154 |
|
|
155 |
(deftest rassoc-22 |
(deftest rassoc.22 |
156 |
(rassoc "a" |
(rassoc "a" |
157 |
(copy-tree |
(copy-tree |
158 |
(rev-assoc-list |
(rev-assoc-list |
159 |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
160 |
:key #'(lambda (x) (and (stringp x) (string-downcase x))) |
:key #'(lambda (x) (and (stringp x) (string-downcase x))) |
161 |
:test-not (complement #'equal)) |
:test-not (complement #'equal)) |
162 |
(6 . "A")) |
(6 . "A")) |
163 |
|
|
164 |
(deftest rassoc-23 |
(deftest rassoc.23 |
165 |
(rassoc "a" |
(rassoc "a" |
166 |
(copy-tree |
(copy-tree |
167 |
(rev-assoc-list |
(rev-assoc-list |
168 |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
'(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5)))) |
169 |
:key #'(lambda (x) (and (stringp x) x)) |
:key #'(lambda (x) (and (stringp x) x)) |
170 |
:test-not (complement #'equal)) |
:test-not (complement #'equal)) |
171 |
(3 . "a")) |
(3 . "a")) |
172 |
|
|
173 |
;; Check that it works when test returns a true value |
;; Check that it works when test returns a true value |
174 |
;; other than T |
;; other than T |
175 |
|
|
176 |
(deftest rassoc-24 |
(deftest rassoc.24 |
177 |
(rassoc 'a |
(rassoc 'a |
178 |
(copy-tree |
(copy-tree |
179 |
(rev-assoc-list |
(rev-assoc-list |
180 |
'((b . 1) (a . 2) (c . 3)))) |
'((b . 1) (a . 2) (c . 3)))) |
181 |
:test #'(lambda (x y) (and (eqt x y) 'matched))) |
:test #'(lambda (x y) (and (eqt x y) 'matched))) |
182 |
(2 . a)) |
(2 . a)) |
183 |
|
|
184 |
;; Check that the order of the arguments to :test is correct |
;; Check that the order of the arguments to :test is correct |
185 |
|
|
186 |
(deftest rassoc-25 |
(deftest rassoc.25 |
187 |
(block fail |
(block fail |
188 |
(rassoc 'a '((1 . b) (2 . c) (3 . a)) |
(rassoc 'a '((1 . b) (2 . c) (3 . a)) |
189 |
:test #'(lambda (x y) |
:test #'(lambda (x y) |
190 |
(unless (eqt x 'a) (return-from fail 'fail)) |
(unless (eqt x 'a) (return-from fail 'fail)) |
191 |
(eqt x y)))) |
(eqt x y)))) |
192 |
(3 . A)) |
(3 . A)) |
193 |
|
|
194 |
|
;;; Order of argument evaluation |
195 |
|
|
196 |
|
(deftest rassoc.26 |
197 |
|
(let ((i 0) x y) |
198 |
|
(values |
199 |
|
(rassoc (progn (setf x (incf i)) 'c) |
200 |
|
(progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c)))) |
201 |
|
i x y)) |
202 |
|
(3 . c) 2 1 2) |
203 |
|
|
204 |
|
(deftest rassoc.27 |
205 |
|
(let ((i 0) x y z) |
206 |
|
(values |
207 |
|
(rassoc (progn (setf x (incf i)) 'c) |
208 |
|
(progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c))) |
209 |
|
:test (progn (setf z (incf i)) #'eq)) |
210 |
|
i x y z)) |
211 |
|
(3 . c) 3 1 2 3) |
212 |
|
|
213 |
|
(deftest rassoc.28 |
214 |
|
(let ((i 0) x y) |
215 |
|
(values |
216 |
|
(rassoc (progn (setf x (incf i)) 'c) |
217 |
|
(progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c))) |
218 |
|
:test #'eq) |
219 |
|
i x y)) |
220 |
|
(3 . c) 2 1 2) |
221 |
|
|
222 |
|
(deftest rassoc.29 |
223 |
|
(let ((i 0) x y z w) |
224 |
|
(values |
225 |
|
(rassoc (progn (setf x (incf i)) 'c) |
226 |
|
(progn (setf y (incf i)) '((1 . a) (2 . b) (3 . c) (4 . c))) |
227 |
|
:key (progn (setf z (incf i)) #'identity) |
228 |
|
:key (progn (setf w (incf i)) #'not)) |
229 |
|
i x y z w)) |
230 |
|
(3 . c) 4 1 2 3 4) |
231 |
|
|
232 |
;;; Keyword tests |
;;; Keyword tests |
233 |
|
|
234 |
(deftest rassoc.allow-other-keys.1 |
(deftest rassoc.allow-other-keys.1 |
287 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
288 |
;;; rassoc-if |
;;; rassoc-if |
289 |
|
|
290 |
(deftest rassoc-if-1 |
(deftest rassoc-if.1 |
291 |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
292 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
293 |
(result (rassoc-if #'evenp x))) |
(result (rassoc-if #'evenp x))) |
297 |
result)) |
result)) |
298 |
(c . 6)) |
(c . 6)) |
299 |
|
|
300 |
(deftest rassoc-if-2 |
(deftest rassoc-if.2 |
301 |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
302 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
303 |
(result (rassoc-if #'oddp x :key #'1+))) |
(result (rassoc-if #'oddp x :key #'1+))) |
307 |
result)) |
result)) |
308 |
(c . 6)) |
(c . 6)) |
309 |
|
|
310 |
(deftest rassoc-if-3 |
(deftest rassoc-if.3 |
311 |
(let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) |
(let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) |
312 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
313 |
(result (rassoc-if #'evenp x))) |
(result (rassoc-if #'evenp x))) |
317 |
result)) |
result)) |
318 |
(c . 6)) |
(c . 6)) |
319 |
|
|
320 |
(deftest rassoc-if-4 |
(deftest rassoc-if.4 |
321 |
(rassoc-if #'null |
(rassoc-if #'null |
322 |
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g)))) |
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g)))) |
323 |
(e)) |
(e)) |
324 |
|
|
325 |
|
;;; Order of argument evaluation |
326 |
|
|
327 |
|
(deftest rassoc-if.5 |
328 |
|
(let ((i 0) x y) |
329 |
|
(values |
330 |
|
(rassoc-if (progn (setf x (incf i)) #'null) |
331 |
|
(progn (setf y (incf i)) |
332 |
|
'((1 . a) (2 . b) (17) (4 . d)))) |
333 |
|
i x y)) |
334 |
|
(17) 2 1 2) |
335 |
|
|
336 |
|
(deftest rassoc-if.6 |
337 |
|
(let ((i 0) x y z) |
338 |
|
(values |
339 |
|
(rassoc-if (progn (setf x (incf i)) #'null) |
340 |
|
(progn (setf y (incf i)) |
341 |
|
'((1 . a) (2 . b) (17) (4 . d))) |
342 |
|
:key (progn (setf z (incf i)) #'null)) |
343 |
|
i x y z)) |
344 |
|
(1 . a) 3 1 2 3) |
345 |
|
|
346 |
|
|
347 |
;;; Keyword tests |
;;; Keyword tests |
348 |
|
|
349 |
(deftest rassoc-if.allow-other-keys.1 |
(deftest rassoc-if.allow-other-keys.1 |
400 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
401 |
;;; rassoc-if-not |
;;; rassoc-if-not |
402 |
|
|
403 |
(deftest rassoc-if-not-1 |
(deftest rassoc-if-not.1 |
404 |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
405 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
406 |
(result (rassoc-if-not #'oddp x))) |
(result (rassoc-if-not #'oddp x))) |
410 |
result)) |
result)) |
411 |
(c . 6)) |
(c . 6)) |
412 |
|
|
413 |
(deftest rassoc-if-not-2 |
(deftest rassoc-if-not.2 |
414 |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) |
415 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
416 |
(result (rassoc-if-not #'evenp x :key #'1+))) |
(result (rassoc-if-not #'evenp x :key #'1+))) |
420 |
result)) |
result)) |
421 |
(c . 6)) |
(c . 6)) |
422 |
|
|
423 |
(deftest rassoc-if-not-3 |
(deftest rassoc-if-not.3 |
424 |
(let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) |
(let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) |
425 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
426 |
(result (rassoc-if-not #'oddp x))) |
(result (rassoc-if-not #'oddp x))) |
430 |
result)) |
result)) |
431 |
(c . 6)) |
(c . 6)) |
432 |
|
|
433 |
(deftest rassoc-if-not-4 |
(deftest rassoc-if-not.4 |
434 |
(rassoc-if-not #'identity |
(rassoc-if-not #'identity |
435 |
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g)))) |
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g)))) |
436 |
(e)) |
(e)) |
437 |
|
|
438 |
|
;;; Order of argument evaluation |
439 |
|
|
440 |
|
(deftest rassoc-if-not.5 |
441 |
|
(let ((i 0) x y) |
442 |
|
(values |
443 |
|
(rassoc-if-not (progn (setf x (incf i)) #'identity) |
444 |
|
(progn (setf y (incf i)) |
445 |
|
'((1 . a) (2 . b) (17) (4 . d)))) |
446 |
|
i x y)) |
447 |
|
(17) 2 1 2) |
448 |
|
|
449 |
|
(deftest rassoc-if-not.6 |
450 |
|
(let ((i 0) x y z) |
451 |
|
(values |
452 |
|
(rassoc-if-not (progn (setf x (incf i)) #'identity) |
453 |
|
(progn (setf y (incf i)) |
454 |
|
'((1 . a) (2 . b) (17) (4 . d))) |
455 |
|
:key (progn (setf z (incf i)) #'null)) |
456 |
|
i x y z)) |
457 |
|
(1 . a) 3 1 2 3) |
458 |
|
|
459 |
;;; Keyword tests |
;;; Keyword tests |
460 |
|
|
461 |
(deftest rassoc-if-not.allow-other-keys.1 |
(deftest rassoc-if-not.allow-other-keys.1 |