source: trunk/source/tests/ansi-tests/pushnew.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 6.3 KB
Line 
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))
Note: See TracBrowser for help on using the repository browser.