source: trunk/source/tests/ansi-tests/nunion.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: 9.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 07:42:35 2003
4;;;; Contains: Tests of NUNION
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest nunion.1
11    (nunion nil nil)
12  nil)
13
14(deftest nunion.2
15    (nunion-with-copy (list 'a) nil)
16  (a))
17
18(deftest nunion.3
19    (nunion-with-copy (list 'a) (list 'a))
20  (a))
21
22(deftest nunion.4
23    (nunion-with-copy (list 1) (list 1))
24  (1))
25
26(deftest nunion.5
27    (let ((x (list 'a 'b)))
28      (nunion-with-copy (list x) (list x)))
29  ((a b)))
30
31(deftest nunion.6
32    (let ((x '(a b c d e f))
33          (y '(z c y a v b)))
34      (let ((result (nunion-with-copy x y)))
35        (check-union x y result)))
36  t)
37
38(deftest nunion.6-a
39    (let ((x '(a b c d e f))
40          (y '(z c y a v b)))
41      (let ((result (nunion-with-copy x y :test #'eq)))
42        (check-union x y result)))
43  t)
44
45(deftest nunion.7
46    (let ((x '(a b c d e f))
47          (y '(z c y a v b)))
48      (let ((result (nunion-with-copy x y :test #'eql)))
49        (check-union x y result)))
50  t)
51
52(deftest nunion.8
53    (let ((x '(a b c d e f))
54          (y '(z c y a v b)))
55      (let ((result (nunion-with-copy x y :test #'equal)))
56        (check-union x y result)))
57  t)
58
59(deftest nunion.9
60    (let ((x  '(a b c d e f))
61          (y  '(z c y a v b)))
62      (let ((result (nunion-with-copy x y :test-not (complement #'eql))))
63        (check-union x y result)))
64  t)
65
66(deftest nunion.10
67    (let ((x '(a b c d e f))
68          (y '(z c y a v b)))
69      (let ((result (nunion-with-copy x y :test-not (complement #'equal))))
70        (check-union x y result)))
71  t)
72
73(deftest nunion.11
74    (let ((x '(a b c d e f))
75          (y '(z c y a v b)))
76      (let ((result (nunion-with-copy x y :test-not (complement #'eq))))
77        (check-union x y result)))
78  t)
79
80(deftest nunion.12
81    (let ((x '(1 2 3 4 5 6 7))
82          (y '(10 19 5 3 17 1001 2)))
83      (let ((result (nunion-with-copy x y)))
84        (check-union x y result)))
85  t)
86
87(deftest nunion.13
88    (let ((x '(1 2 3 4 5 6 7))
89          (y '(10 19 5 3 17 1001 2)))
90      (let ((result (nunion-with-copy x y :test #'equal)))
91        (check-union x y result)))
92  t)
93
94(deftest nunion.14
95    (let ((x '(1 2 3 4 5 6 7))
96          (y '(10 19 5 3 17 1001 2)))
97      (let ((result (nunion-with-copy x y :test #'eql)))
98        (check-union x y result)))
99  t)
100
101(deftest nunion.15
102    (let ((x '(1 2 3 4 5 6 7))
103          (y '(10 19 5 3 17 1001 2)))
104      (let ((result (nunion-with-copy x y :test-not (complement #'equal))))
105        (check-union x y result)))
106  t)
107
108(deftest nunion.16
109    (let ((x '(1 2 3 4 5 6 7))
110          (y '(10 19 5 3 17 1001 2)))
111      (let ((result (nunion-with-copy x y :test-not (complement  #'eql))))
112        (check-union x y result)))
113  t)
114
115(deftest nunion.17
116    (let ((x '(1 2 3 4 5 6 7))
117          (y '(10 19 5 3 17 1001 2)))
118      (let ((result (nunion-with-copy-and-key x y #'1+)))
119        (check-union x y result)))
120  t)
121
122(deftest nunion.18
123    (let ((x '(1 2 3 4 5 6 7))
124          (y '(10 19 5 3 17 1001 2)))
125      (let ((result (nunion-with-copy-and-key x y #'1+ :test #'equal)))
126        (check-union x y result)))
127  t)
128
129(deftest nunion.19
130    (let ((x '(1 2 3 4 5 6 7))
131          (y '(10 19 5 3 17 1001 2)))
132      (let ((result (nunion-with-copy-and-key x y #'1+ :test #'eql)))
133        (check-union x y result)))
134  t)
135
136(deftest nunion.20
137    (let ((x '(1 2 3 4 5 6 7))
138          (y '(10 19 5 3 17 1001 2)))
139      (let ((result (nunion-with-copy-and-key x y #'1+
140                                              :test-not (complement #'equal))))
141        (check-union x y result)))
142  t)
143
144(deftest nunion.21
145    (let ((x '(1 2 3 4 5 6 7))
146          (y '(10 19 5 3 17 1001 2)))
147      (let ((result (nunion-with-copy-and-key x y #'1+
148                                              :test-not (complement #'equal))))
149        (check-union x y result)))
150  t)
151
152(deftest nunion.22
153  (let ((x '(1 2 3 4 5 6 7))
154        (y '(10 19 5 3 17 1001 2)))
155    (let ((result (nunion-with-copy-and-key x y nil)))
156      (check-union x y result)))
157  t)
158
159(deftest nunion.23
160  (let ((x '(1 2 3 4 5 6 7))
161        (y '(10 19 5 3 17 1001 2)))
162    (let ((result (nunion-with-copy-and-key x y '1+)))
163      (check-union x y result)))
164  t)
165
166;; Do large numbers of random nunions
167
168(deftest nunion.24
169  (do-random-nunions 100 100 200)
170  nil)
171
172(deftest nunion.25
173  (let ((x (shuffle '(1 4 6 10 45 101)))
174        (y '(102 5 2 11 44 6)))
175    (let ((result (nunion-with-copy x y
176                                    :test #'(lambda (a b)
177                                              (<= (abs (- a b)) 1)))))
178      (sort
179       (sublis
180        '((2 . 1) (5 . 4) (11 . 10) (45 . 44) (102 . 101))
181        (copy-list result))
182       #'<)))
183  (1 4 6 10 44 101))
184
185;; Check that nunion uses eql, not equal or eq
186
187(deftest nunion.26
188  (let ((x 1000)
189        (y 1000))
190    (loop
191     while (not (typep x 'bignum))
192     do (progn
193          (setf x (* x x))
194          (setf y (* y y))))
195    (notnot-mv
196     (or
197      (eqt x y)  ;; if bignums are eq, the test is worthless
198      (eql (length
199            (nunion-with-copy (list x) (list x)))
200           1))))
201  t)
202
203(deftest nunion.27
204  (nunion-with-copy (list (copy-seq "aa"))
205                    (list (copy-seq "aa")))
206  ("aa" "aa"))
207
208(defharmless nunion.test-and-test-not.1
209  (nunion (list 1 4 8 10) (list 1 2 3 9 10 13) :test #'eql :test-not #'eql))
210
211(defharmless nunion.test-and-test-not.2
212  (nunion (list 1 4 8 10) (list 1 2 3 9 10 13) :test-not #'eql :test #'eql))
213
214;; Check that nunion does not reverse the arguments to :test, :test-not
215
216(deftest nunion.28
217    (block fail
218      (sort
219       (nunion-with-copy
220        '(1 2 3)
221        '(4 5 6)
222        :test #'(lambda (x y)
223                  (when (< y x) (return-from fail 'fail))
224                  (eql x y)))
225       #'<))
226  (1 2 3 4 5 6))
227
228(deftest nunion.29
229    (block fail
230      (sort
231       (nunion-with-copy-and-key
232        '(1 2 3)
233        '(4 5 6)
234        #'identity
235        :test #'(lambda (x y)
236                  (when (< y x) (return-from fail 'fail))
237                  (eql x y)))
238       #'<))
239  (1 2 3 4 5 6))
240
241(deftest nunion.30
242    (block fail
243      (sort
244       (nunion-with-copy
245        '(1 2 3)
246        '(4 5 6)
247        :test-not
248        #'(lambda (x y)
249            (when (< y x) (return-from fail 'fail))
250            (not (eql x y))))
251       #'<))
252  (1 2 3 4 5 6))
253
254(deftest nunion.31
255    (block fail
256      (sort
257       (nunion-with-copy-and-key
258        '(1 2 3)
259        '(4 5 6)
260        #'identity
261        :test-not #'(lambda (x y)
262                      (when (< y x) (return-from fail 'fail))
263                      (not (eql x y))))
264       #'<))
265  (1 2 3 4 5 6))
266
267;;; Order of evaluation tests
268
269(deftest nunion.order.1
270  (let ((i 0) x y)
271    (values
272     (sort
273      (nunion (progn (setf x (incf i)) (copy-list '(1 3 5)))
274              (progn (setf y (incf i)) (copy-list '(2 5 8))))
275      #'<)
276     i x y))
277  (1 2 3 5 8)
278  2 1 2)
279
280(deftest nunion.order.2
281  (let ((i 0) x y z w)
282    (values
283     (sort
284      (nunion (progn (setf x (incf i)) (copy-list '(1 3 5)))
285              (progn (setf y (incf i)) (copy-list '(2 5 8)))
286              :test (progn (setf z (incf i)) #'eql)
287              :key (progn (setf w (incf i)) #'identity))
288      #'<)
289     i x y z w))
290  (1 2 3 5 8)
291  4 1 2 3 4)
292
293
294(deftest nunion.order.3
295  (let ((i 0) x y z w)
296    (values
297     (sort
298      (nunion (progn (setf x (incf i)) (copy-list '(1 3 5)))
299              (progn (setf y (incf i)) (copy-list '(2 5 8)))
300              :key (progn (setf z (incf i)) #'identity)
301              :test (progn (setf w (incf i)) #'eql))
302      #'<)
303     i x y z w))
304  (1 2 3 5 8)
305  4 1 2 3 4)
306
307;;; Keyword tests
308
309(deftest nunion.allow-other-keys.1
310  (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) :bad t
311               :allow-other-keys "yes")
312        #'<)
313  (1 2 5 7 9 10 11 20))
314
315(deftest nunion.allow-other-keys.2
316  (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
317               :allow-other-keys t :also-bad t)
318        #'<)
319  (1 2 5 7 9 10 11 20))
320
321(deftest nunion.allow-other-keys.3
322  (sort (nunion (list 1 2 3) (list 1 2 3)
323               :allow-other-keys t :also-bad t
324               :test #'(lambda (x y) (= x (+ y 100))))
325        #'<)
326  (1 1 2 2 3 3))
327
328(deftest nunion.allow-other-keys.4
329  (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
330               :allow-other-keys t)
331        #'<)
332  (1 2 5 7 9 10 11 20))
333
334(deftest nunion.allow-other-keys.5
335  (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
336               :allow-other-keys nil)
337        #'<)
338  (1 2 5 7 9 10 11 20))
339
340(deftest nunion.allow-other-keys.6
341  (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
342               :allow-other-keys t
343               :allow-other-keys nil)
344        #'<)
345  (1 2 5 7 9 10 11 20))
346
347(deftest nunion.allow-other-keys.7
348  (sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
349               :allow-other-keys t
350               :allow-other-keys nil
351               '#:x 1)
352        #'<)
353  (1 2 5 7 9 10 11 20))
354
355(deftest nunion.keywords.9
356  (sort (nunion (list 1 2 3) (list 1 2 3)
357               :test #'(lambda (x y) (= x (+ y 100)))
358               :test #'eql)
359        #'<)
360  (1 1 2 2 3 3))
361
362;;; Error tests
363
364(deftest nunion.error.1
365  (signals-error (nunion) program-error)
366  t)
367
368(deftest nunion.error.2
369  (signals-error (nunion nil) program-error)
370  t)
371
372(deftest nunion.error.3
373  (signals-error (nunion nil nil :bad t) program-error)
374  t)
375
376(deftest nunion.error.4
377  (signals-error (nunion nil nil :key) program-error)
378  t)
379
380(deftest nunion.error.5
381  (signals-error (nunion nil nil 1 2) program-error)
382  t)
383
384(deftest nunion.error.6
385  (signals-error (nunion nil nil :bad t :allow-other-keys nil) program-error)
386  t)
387
388(deftest nunion.error.7
389  (signals-error (nunion (list 1 2) (list 3 4) :test #'identity) program-error)
390  t)
391
392(deftest nunion.error.8
393  (signals-error (nunion (list 1 2) (list 3 4) :test-not #'identity) program-error)
394  t)
395
396(deftest nunion.error.9
397  (signals-error (nunion (list 1 2) (list 3 4) :key #'cons) program-error)
398  t)
399
400(deftest nunion.error.10
401  (signals-error (nunion (list 1 2) (list 3 4) :key #'car) type-error)
402  t)
403
404(deftest nunion.error.11
405  (signals-error (nunion (list 1 2 3) (list* 4 5 6)) type-error)
406  t)
407
408(deftest nunion.error.12
409  (signals-error (nunion (list* 1 2 3) (list 4 5 6)) type-error)
410  t)
411
412(deftest nunion.error.13
413  (check-type-error #'(lambda (x) (nunion x (list 1 2 3))) #'listp)
414  nil)
415
416(deftest nunion.error.14
417  (check-type-error #'(lambda (x) (nunion (list 1 2 3) x)) #'listp)
418  nil)
Note: See TracBrowser for help on using the repository browser.