1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sat Apr 19 22:28:35 2003 |
---|
4 | ;;;; Contains: Tests of PUSHNEW |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (compile-and-load "cons-aux.lsp") |
---|
9 | |
---|
10 | (deftest pushnew.1 |
---|
11 | (let ((x nil)) |
---|
12 | (let ((y (pushnew 'a x))) |
---|
13 | (and |
---|
14 | (eqt x y) |
---|
15 | (equal x '(a)) |
---|
16 | t))) |
---|
17 | t) |
---|
18 | |
---|
19 | (deftest pushnew.2 |
---|
20 | (let* ((x (copy-tree '(b c d a k f q))) |
---|
21 | (y (pushnew 'a x))) |
---|
22 | (and |
---|
23 | (eqt x y) |
---|
24 | x)) |
---|
25 | (b c d a k f q)) |
---|
26 | |
---|
27 | (deftest pushnew.3 |
---|
28 | (let* ((x (copy-tree '(1 2 3 4 5 6 7 8))) |
---|
29 | (y (pushnew 7 x))) |
---|
30 | (and |
---|
31 | (eqt x y) |
---|
32 | x)) |
---|
33 | (1 2 3 4 5 6 7 8)) |
---|
34 | |
---|
35 | (deftest pushnew.4 |
---|
36 | (let* ((x (copy-tree '((a b) 1 "and" c d e))) |
---|
37 | (y (pushnew (copy-tree '(c d)) x |
---|
38 | :test 'equal))) |
---|
39 | (and (eqt x y) |
---|
40 | x)) |
---|
41 | ((c d) (a b) 1 "and" c d e)) |
---|
42 | |
---|
43 | (deftest pushnew.5 |
---|
44 | (let* ((x (copy-tree '((a b) 1 "and" c d e))) |
---|
45 | (y (pushnew (copy-tree '(a b)) x |
---|
46 | :test 'equal))) |
---|
47 | (and |
---|
48 | (eqt x y) |
---|
49 | x)) |
---|
50 | ((a b) 1 "and" c d e)) |
---|
51 | |
---|
52 | (deftest pushnew.6 |
---|
53 | (let* ((x (copy-tree '((a b) (c e) (d f) (g h)))) |
---|
54 | (y (pushnew (copy-tree '(d i)) x :key #'car)) |
---|
55 | (z (pushnew (copy-tree '(z 10)) x :key #'car))) |
---|
56 | (and (eqt y (cdr z)) |
---|
57 | (eqt z x) |
---|
58 | x)) |
---|
59 | ((z 10) (a b) (c e) (d f) (g h))) |
---|
60 | |
---|
61 | (deftest pushnew.7 |
---|
62 | (let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3)))) |
---|
63 | (y (pushnew (copy-tree '("def" 4)) x |
---|
64 | :key #'car :test #'string=)) |
---|
65 | (z (pushnew (copy-tree '("xyz" 10)) |
---|
66 | x |
---|
67 | :key #'car :test #'string=))) |
---|
68 | (and |
---|
69 | (eqt y (cdr x)) |
---|
70 | (eqt x z) |
---|
71 | x)) |
---|
72 | (("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3))) |
---|
73 | |
---|
74 | (deftest pushnew.8 |
---|
75 | (let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3)))) |
---|
76 | (y (pushnew (copy-tree '("def" 4)) x |
---|
77 | :key #'car :test-not (complement #'string=))) |
---|
78 | (z (pushnew (copy-tree '("xyz" 10)) x |
---|
79 | :key #'car :test-not (complement #'string=)))) |
---|
80 | (and |
---|
81 | (eqt y (cdr x)) |
---|
82 | (eqt x z) |
---|
83 | x)) |
---|
84 | (("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3))) |
---|
85 | |
---|
86 | (deftest pushnew.9 |
---|
87 | (let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3)))) |
---|
88 | (y (pushnew (copy-tree '("def" 4)) x |
---|
89 | :key 'car :test-not (complement #'string=))) |
---|
90 | (z (pushnew (copy-tree '("xyz" 10)) x |
---|
91 | :key 'car :test-not (complement #'string=)))) |
---|
92 | (and |
---|
93 | (eqt y (cdr x)) |
---|
94 | (eqt x z) |
---|
95 | x)) |
---|
96 | (("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3))) |
---|
97 | |
---|
98 | ;; Check that a NIL :key argument is the same as no key argument at all |
---|
99 | (deftest pushnew.10 |
---|
100 | (let* ((x (list 'a 'b 'c 'd)) |
---|
101 | (result (pushnew 'z x :key nil))) |
---|
102 | result) |
---|
103 | (z a b c d)) |
---|
104 | |
---|
105 | ;; Check that a NIL :key argument is the same as no key argument at all |
---|
106 | (deftest pushnew.11 |
---|
107 | (let* ((x (copy-tree '((a b) 1 "and" c d e))) |
---|
108 | (y (pushnew (copy-tree '(a b)) x |
---|
109 | :test 'equal :key nil))) |
---|
110 | (and |
---|
111 | (eqt x y) |
---|
112 | x)) |
---|
113 | ((a b) 1 "and" c d e)) |
---|
114 | |
---|
115 | (deftest pushnew.12 |
---|
116 | (let ((i 0) x y z (d '(b c))) |
---|
117 | (values |
---|
118 | (pushnew (progn (setf x (incf i)) 'a) |
---|
119 | d |
---|
120 | :key (progn (setf y (incf i)) #'identity) |
---|
121 | :test (progn (setf z (incf i)) #'eql)) |
---|
122 | d i x y z)) |
---|
123 | (a b c) (a b c) |
---|
124 | 3 1 2 3) |
---|
125 | |
---|
126 | (deftest pushnew.13 |
---|
127 | (let ((i 0) x y z (d '(b c))) |
---|
128 | (values |
---|
129 | (pushnew (progn (setf x (incf i)) 'a) |
---|
130 | d |
---|
131 | :key (progn (setf y (incf i)) #'identity) |
---|
132 | :test-not (progn (setf z (incf i)) (complement #'eql))) |
---|
133 | d i x y z)) |
---|
134 | (a b c) (a b c) |
---|
135 | 3 1 2 3) |
---|
136 | |
---|
137 | (deftest pushnew.14 |
---|
138 | (let ((i 0) x y z (d '(b c))) |
---|
139 | (values |
---|
140 | (pushnew (progn (setf x (incf i)) 'a) |
---|
141 | d |
---|
142 | :test (progn (setf z (incf i)) #'eql) |
---|
143 | :key (progn (setf y (incf i)) #'identity)) |
---|
144 | d i x y z)) |
---|
145 | (a b c) (a b c) |
---|
146 | 3 1 3 2) |
---|
147 | |
---|
148 | (deftest pushnew.15 |
---|
149 | (let ((i 0) x y z (d '(b c))) |
---|
150 | (values |
---|
151 | (pushnew (progn (setf x (incf i)) 'a) |
---|
152 | d |
---|
153 | :test-not (progn (setf z (incf i)) (complement #'eql)) |
---|
154 | :key (progn (setf y (incf i)) #'identity)) |
---|
155 | d i x y z)) |
---|
156 | (a b c) (a b c) |
---|
157 | 3 1 3 2) |
---|
158 | |
---|
159 | (deftest pushnew.16 |
---|
160 | (let ((x '(1 2 3))) |
---|
161 | (values |
---|
162 | (pushnew 10 x :test #'<=) |
---|
163 | x)) |
---|
164 | (10 1 2 3) |
---|
165 | (10 1 2 3)) |
---|
166 | |
---|
167 | (deftest pushnew.17 |
---|
168 | (let ((x '(1 2 3))) |
---|
169 | (values |
---|
170 | (pushnew 10 x :test #'>) |
---|
171 | x)) |
---|
172 | (1 2 3) |
---|
173 | (1 2 3)) |
---|
174 | (deftest pushnew.18 |
---|
175 | (let ((x '(1 2 3))) |
---|
176 | (values |
---|
177 | (pushnew 10 x :test-not #'>) |
---|
178 | x)) |
---|
179 | (10 1 2 3) |
---|
180 | (10 1 2 3)) |
---|
181 | |
---|
182 | (deftest pushnew.19 |
---|
183 | (let ((x '(1 2 3))) |
---|
184 | (values |
---|
185 | (pushnew 10 x :test-not #'<=) |
---|
186 | x)) |
---|
187 | (1 2 3) |
---|
188 | (1 2 3)) |
---|
189 | |
---|
190 | ;;; Test that explicit calls to macroexpand in subforms |
---|
191 | ;;; are done in the correct environment |
---|
192 | |
---|
193 | (deftest pushnew.20 |
---|
194 | (macrolet |
---|
195 | ((%m (z) z)) |
---|
196 | (let ((x nil)) |
---|
197 | (values |
---|
198 | (pushnew (expand-in-current-env (%m 1)) x) |
---|
199 | x))) |
---|
200 | (1) (1)) |
---|
201 | |
---|
202 | (deftest pushnew.21 |
---|
203 | (macrolet |
---|
204 | ((%m (z) z)) |
---|
205 | (let ((x nil)) |
---|
206 | (values |
---|
207 | (pushnew 1 (expand-in-current-env (%m x))) |
---|
208 | x))) |
---|
209 | (1) (1)) |
---|
210 | |
---|
211 | (deftest pushnew.22 |
---|
212 | (macrolet |
---|
213 | ((%m (z) z)) |
---|
214 | (let ((x '(a b))) |
---|
215 | (values |
---|
216 | (pushnew 1 x :test (expand-in-current-env (%m #'eql))) |
---|
217 | x))) |
---|
218 | (1 a b) (1 a b)) |
---|
219 | |
---|
220 | (deftest pushnew.23 |
---|
221 | (macrolet |
---|
222 | ((%m (z) z)) |
---|
223 | (let ((x '(1))) |
---|
224 | (values |
---|
225 | (pushnew 1 x :test-not (expand-in-current-env (%m #'eql))) |
---|
226 | x))) |
---|
227 | (1 1) (1 1)) |
---|
228 | |
---|
229 | (deftest pushnew.24 |
---|
230 | (macrolet |
---|
231 | ((%m (z) z)) |
---|
232 | (let ((x '(3))) |
---|
233 | (values |
---|
234 | (pushnew 1 x :key (expand-in-current-env (%m #'evenp))) |
---|
235 | x))) |
---|
236 | (3) (3)) |
---|
237 | |
---|
238 | (defharmless pushnew.test-and-test-not.1 |
---|
239 | (let ((x '(b c))) (pushnew 'a x :test #'eql :test-not #'eql))) |
---|
240 | |
---|
241 | (defharmless pushnew.test-and-test-not.2 |
---|
242 | (let ((x '(b c))) (pushnew 'a x :test-not #'eql :test #'eql))) |
---|
243 | |
---|
244 | |
---|
245 | (deftest pushnew.order.1 |
---|
246 | (let ((x (vector nil nil nil nil)) |
---|
247 | (y (vector 'a 'b 'c 'd)) |
---|
248 | (i 1)) |
---|
249 | (pushnew (aref y (incf i)) (aref x (incf i))) |
---|
250 | (values x y i)) |
---|
251 | #(nil nil nil (c)) |
---|
252 | #(a b c d) |
---|
253 | 3) |
---|
254 | |
---|
255 | (deftest pushnew.order.2 |
---|
256 | (let ((x (vector nil nil nil nil nil)) |
---|
257 | (y (vector 'a 'b 'c 'd 'e)) |
---|
258 | (i 1)) |
---|
259 | (pushnew (aref y (incf i)) (aref x (incf i)) |
---|
260 | :test (progn (incf i) #'eql)) |
---|
261 | (values x y i)) |
---|
262 | #(nil nil nil (c) nil) |
---|
263 | #(a b c d e) |
---|
264 | 4) |
---|
265 | |
---|
266 | (deftest pushnew.order.3 |
---|
267 | (let ((x '(a b c))) |
---|
268 | (values |
---|
269 | (pushnew (progn (setq x '(d e)) 'z) x) |
---|
270 | x)) |
---|
271 | (z d e) (z d e)) |
---|
272 | |
---|
273 | (deftest pushnew.error.1 |
---|
274 | (signals-error |
---|
275 | (let ((x '(a b))) |
---|
276 | (pushnew 'c x :test #'identity)) |
---|
277 | program-error) |
---|
278 | t) |
---|
279 | |
---|
280 | (deftest pushnew.error.2 |
---|
281 | (signals-error |
---|
282 | (let ((x '(a b))) |
---|
283 | (pushnew 'c x :test-not #'identity)) |
---|
284 | program-error) |
---|
285 | t) |
---|
286 | |
---|
287 | (deftest pushnew.error.3 |
---|
288 | (signals-error |
---|
289 | (let ((x '(a b))) |
---|
290 | (pushnew 'c x :key #'cons)) |
---|
291 | program-error) |
---|
292 | t) |
---|
293 | |
---|
294 | (def-macro-test pushnew.error.4 (pushnew x y)) |
---|