source: trunk/source/tests/ansi-tests/random-type-prop-tests-05.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: 26.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Mar  8 20:31:08 2005
4;;;; Contains: Random type prop tests, part 5 (Cons)
5
6(in-package :cl-test)
7
8(def-type-prop-test list.1 'list nil 1 :rest-type 't :maxargs 10)
9(def-type-prop-test list.2 '(lambda (x) (car (list x))) '(t) 1)
10(def-type-prop-test list.3 '(lambda (x y) (cdr (list x y))) '(t t) 2)
11(def-type-prop-test list.4 '(lambda (x y z) (cadr (list x y z))) '(t t t) 3)
12(def-type-prop-test list.5 '(lambda (x) (let ((z (list x))) (declare (dynamic-extent z)) (car z)))  '(t) 1)
13
14(def-type-prop-test list* 'list* () 1 :rest-type t :maxargs 10)
15
16(def-type-prop-test null 'null '(t) 1)
17(def-type-prop-test cons.1 'cons '(t t) 2)
18(def-type-prop-test cons.2 '(lambda (x y) (car (cons y x))) '(t t) 2)
19(def-type-prop-test cons.3 '(lambda (x y) (cdr (cons x y))) '(t t) 2)
20
21(def-type-prop-test consp 'consp '(t) 1)
22(def-type-prop-test atom 'atom '(t) 1)
23
24(def-type-prop-test rplaca 'rplaca '(cons t) 2 :replicate '(t nil))
25(def-type-prop-test rplacd 'rplacd '(cons t) 2 :replicate '(t nil))
26
27(def-type-prop-test car 'car '((cons t t)) 1)
28(def-type-prop-test first 'first '((cons t t)) 1)
29(def-type-prop-test cdr 'cdr '((cons t t)) 1)
30(def-type-prop-test rest 'rest '((cons t t)) 1)
31(def-type-prop-test caar 'caar '((cons (cons t t) t)) 1)
32(def-type-prop-test cdar 'cdar '((cons (cons t t) t)) 1)
33(def-type-prop-test cadr 'cadr '((cons t (cons t t))) 1)
34(def-type-prop-test second 'second '((cons t (cons t t))) 1)
35(def-type-prop-test cddr 'cddr '((cons t (cons t t))) 1)
36(def-type-prop-test caaar 'caaar '((cons (cons (cons t t) t) t)) 1)
37(def-type-prop-test cdaar 'cdaar '((cons (cons (cons t t) t) t)) 1)
38(def-type-prop-test cadar 'cadar '((cons (cons t (cons t t)) t)) 1)
39(def-type-prop-test cddar 'cddar '((cons (cons t (cons t t)) t)) 1)
40(def-type-prop-test caadr 'caadr '((cons t (cons (cons t t) t))) 1)
41(def-type-prop-test cdadr 'cdadr '((cons t (cons (cons t t) t))) 1)
42(def-type-prop-test caddr 'caddr '((cons t (cons t (cons t t)))) 1)
43(def-type-prop-test third 'third '((cons t (cons t (cons t t)))) 1)
44(def-type-prop-test cdddr 'cdddr '((cons t (cons t (cons t t)))) 1)
45
46(def-type-prop-test caaaar'caaaar '((cons (cons (cons (cons t t) t) t) t)) 1)
47(def-type-prop-test cdaaar 'cdaaar '((cons (cons (cons (cons t t) t) t) t)) 1)
48(def-type-prop-test cadaar 'cadaar '((cons (cons (cons t (cons t t)) t) t)) 1)
49(def-type-prop-test cddaar 'cddaar '((cons (cons (cons t (cons t t)) t) t)) 1)
50(def-type-prop-test caadar 'caadar '((cons (cons t (cons (cons t t) t)) t)) 1)
51(def-type-prop-test cdadar 'cdadar '((cons (cons t (cons (cons t t) t)) t)) 1)
52(def-type-prop-test caddar 'caddar '((cons (cons t (cons t (cons t t))) t)) 1)
53(def-type-prop-test cdddar 'cdddar '((cons (cons t (cons t (cons t t))) t)) 1)
54(def-type-prop-test caaadr 'caaadr '((cons t (cons (cons (cons t t) t) t))) 1)
55(def-type-prop-test cdaadr 'cdaadr '((cons t (cons (cons (cons t t) t) t))) 1)
56(def-type-prop-test cadadr 'cadadr '((cons t (cons (cons t (cons t t)) t))) 1)
57(def-type-prop-test cddadr 'cddadr '((cons t (cons (cons t (cons t t)) t))) 1)
58(def-type-prop-test caaddr 'caaddr '((cons t (cons t (cons (cons t t) t)))) 1)
59(def-type-prop-test cdaddr 'cdaddr '((cons t (cons t (cons (cons t t) t)))) 1)
60(def-type-prop-test cadddr 'cadddr '((cons t (cons t (cons t (cons t t))))) 1)
61(def-type-prop-test fourth 'fourth '((cons t (cons t (cons t (cons t t))))) 1)
62(def-type-prop-test cddddr 'cddddr '((cons t (cons t (cons t (cons t t))))) 1)
63
64(def-type-prop-test fifth 'fifth '((cons t (cons t (cons t (cons t (cons t t)))))) 1)
65(def-type-prop-test sixth 'sixth '((cons t (cons t (cons t (cons t (cons t (cons t t))))))) 1)
66(def-type-prop-test seventh 'seventh '((cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))) 1)
67(def-type-prop-test eighth 'eighth
68  '((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))))
69  1)
70(def-type-prop-test ninth 'ninth
71  '((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t))))))))))
72  1)
73(def-type-prop-test tenth 'tenth
74  '((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))))))
75  1)
76
77(def-type-prop-test pop '(lambda (x) (list (pop x) x)) '((cons t t)) 1)
78(def-type-prop-test push '(lambda (x y) (list (push x y) x y)) '(t t) 2)
79
80(def-type-prop-test copy-tree.1 'copy-tree '((cons t t)) 1)
81(def-type-prop-test copy-tree.2 'copy-tree '((cons (cons t t) (cons t t))) 1)
82(def-type-prop-test copy-tree.3 'copy-tree '((cons t (cons (cons t (cons t t)) t))) 1)
83(def-type-prop-test copy-tree.4 'copy-tree '(list) 1)
84
85(def-type-prop-test sublis.1 'sublis '((cons (cons symbol t) null) list) 2)
86(def-type-prop-test sublis.2 'sublis '((cons (cons (integer 0 7) t) null) list) 2)
87(def-type-prop-test sublis.3 'sublis '(null list) 2)
88(def-type-prop-test sublis.4 'sublis `((cons (cons boolean t) null) list
89                                       (eql :key)
90                                       (or null (eql not) (eql ,#'not))) 4)
91(def-type-prop-test sublis.5 'sublis `((cons (cons t t) null) list (eql :test) (or (eql equal) (eql ,#'equal))) 4)
92(def-type-prop-test sublis.6 'sublis `((cons (cons t t) null) list (eql :test-not) (or (eql eql) (eql ,#'eql))) 4)
93
94(def-type-prop-test subst.1 'subst '(t t t) 3)
95(def-type-prop-test subst.2 'subst '(t t (cons t t)) 3)
96(def-type-prop-test subst.3 'subst '(t t list) 3)
97(def-type-prop-test subst.4 'subst '(t t (cons (cons t t) (cons t t))) 3)
98(def-type-prop-test subst.5 'subst `(boolean t (cons (cons t t) (cons t t))
99                                             (eql :key)
100                                             (or null (eql not) (eql ,#'not))) 5)
101(def-type-prop-test subst.6 'subst `(t t (cons (cons t t) (cons t t)) (eql :test) (or (eql equal) (eql ,#'equal))) 5)
102(def-type-prop-test subst.7 'subst `(t t (cons (cons t t) (cons t t)) (eql :test-not) (or (eql equal) (eql ,#'equal))) 5)
103(def-type-prop-test subst.8 'subst `(t t (cons (cons t t) (cons t t))
104                                       (eql :key) (or null (eql not) (eql ,#'not))
105                                       (eql :test) (or (eql equal) (eql ,#'equal))) 7)
106
107(def-type-prop-test nsubst.1 'nsubst '(t t t) 3 :replicate '(nil nil t))
108(def-type-prop-test nsubst.2 'nsubst '(t t (cons t t)) 3 :replicate '(nil nil t))
109(def-type-prop-test nsubst.3 'nsubst '(t t list) 3 :replicate '(nil nil t))
110(def-type-prop-test nsubst.4 'nsubst '(t t (cons (cons t t) (cons t t))) 3 :replicate '(nil nil t))
111(def-type-prop-test nsubst.5 'nsubst `(boolean t (cons (cons t t) (cons t t))
112                                               (eql :key)
113                                               (or null (eql not) (eql ,#'not))) 5
114                                               :replicate '(nil nil t nil nil))
115(def-type-prop-test nsubst.6 'nsubst `(t t (cons (cons t t) (cons t t)) (eql :test) (or (eql equal) (eql ,#'equal))) 5 :replicate '(nil nil t nil nil))
116(def-type-prop-test nsubst.7 'nsubst `(t t (cons (cons t t) (cons t t)) (eql :test-not) (or (eql equal) (eql ,#'equal))) 5 :replicate '(nil nil t nil nil))
117(def-type-prop-test nsubst.8 'nsubst `(t t (cons (cons t t) (cons t t))
118                                         (eql :key) (or null (eql not) (eql ,#'not))
119                                         (eql :test) (or (eql equal) (eql ,#'equal))) 7
120                                         :replicate '(nil nil t nil nil nil nil))
121
122
123(def-type-prop-test subst-if.1 'subst-if `(t (or (eql not) (eql ,#'not)) list) 3)
124(def-type-prop-test subst-if.2 'subst-if `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3)
125(def-type-prop-test subst-if.3 'subst-if `(t (eql identity)
126                                             (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
127                                             (eql :key) (or null (eql not) (eql ,#'not))) 5)
128
129(def-type-prop-test nsubst-if.1 'nsubst-if `(t (or (eql not) (eql ,#'not)) list) 3 :replicate '(nil nil t))
130(def-type-prop-test nsubst-if.2 'nsubst-if `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3 :replicate '(nil nil t))
131(def-type-prop-test nsubst-if.3 'nsubst-if `(t (eql identity)
132                                               (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
133                                               (eql :key) (or null (eql not) (eql ,#'not))) 5
134                                               :replicate '(nil nil t nil nil))
135
136(def-type-prop-test subst-if-not.1 'subst-if-not `(t (or (eql not) (eql ,#'not)) list) 3)
137(def-type-prop-test subst-if-not.2 'subst-if-not `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3)
138(def-type-prop-test subst-if-not.3 'subst-if-not `(t (eql identity)
139                                                     (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
140                                                     (eql :key) (or null (eql not) (eql ,#'not))) 5)
141
142(def-type-prop-test nsubst-if-not.1 'nsubst-if-not `(t (or (eql not) (eql ,#'not)) list) 3 :replicate '(nil nil t))
143(def-type-prop-test nsubst-if-not.2 'nsubst-if-not `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3 :replicate '(nil nil t))
144(def-type-prop-test nsubst-if-not.3 'nsubst-if-not `(t (eql identity)
145                                                       (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
146                                                       (eql :key) (or null (eql not) (eql ,#'not))) 5
147                                                       :replicate '(nil nil t nil nil))
148
149(def-type-prop-test tree-equal.1 'tree-equal (list t #'(lambda (x) `(or t (eql ,(copy-tree x))))) 2)
150(def-type-prop-test tree-equal.2 'tree-equal (list 'list #'(lambda (x) `(or list (eql ,(copy-tree t))))) 2)
151(def-type-prop-test tree-equal.3 'tree-equal (list '(cons t t)
152                                                   #'(lambda (x) `(or (cons t t) (eql ,(copy-tree x))))
153                                                   '(eql :test)
154                                                   `(or (eql equal) (eql ,#'equal)))
155  4)
156(def-type-prop-test tree-equal.4 'tree-equal (list t #'(lambda (x) `(or t (eql ,(copy-tree x))))
157                                                   '(eql :test-not) '(eql eql))
158  4)
159
160(def-type-prop-test copy-list.1 'copy-list '(list) 1)
161(def-type-prop-test copy-list.2 'copy-list '((cons t t)) 1)
162(def-type-prop-test copy-list.3 'copy-list '((cons t (cons t (or t (cons t (or t (cons t t))))))) 1)
163
164(def-type-prop-test list-length.1 'list-length '(list) 1)
165(def-type-prop-test list-length.2 'list-length '((cons t list)) 1)
166
167(def-type-prop-test listp 'listp '(t) 1)
168
169(def-type-prop-test make-list.1 'make-list '((integer 0 100)) 1)
170(def-type-prop-test make-list.2 '(lambda (x) (length (make-list x))) '((integer 0 100)) 1)
171(def-type-prop-test make-list.3 'make-list '((integer 0 100) (eql :initial-element) t) 3)
172
173(def-type-prop-test nth.1 'nth '((integer 0 12) list) 2)
174
175(def-type-prop-test endp.1 'endp '((or null (cons t t))) 1)
176
177(def-type-prop-test append.1 'append nil 1 :maxargs 10 :rest-type 'list)
178(def-type-prop-test append.2 'append '(list t) 2)
179(def-type-prop-test append.3 'append '(list list t) 3)
180(def-type-prop-test append.4 'append '(list list list t) 4)
181
182(def-type-prop-test nconc.1 'nconc '(list) 1)
183(def-type-prop-test nconc.2 'nconc '(list list) 2 :replicate '(t nil))
184(def-type-prop-test nconc.3 'nconc '(list list list) 3 :replicate '(t t nil))
185(def-type-prop-test nconc.4 'nconc '(list list list list) 4 :replicate '(t t t nil))
186
187(def-type-prop-test revappend 'revappend '(list t) 2)
188(def-type-prop-test nreconc 'nreconc '(list t) 2 :replicate '(t nil))
189
190(def-type-prop-test butlast.1 'butlast '(list) 1)
191(def-type-prop-test butlast.2 'butlast '(list (integer 0 20)) 2)
192
193(def-type-prop-test nbutlast.1 'nbutlast '(list) 1 :replicate '(t))
194(def-type-prop-test nbutlast.2 'nbutlast '(list (integer 0 20)) 2 :replicate '(t nil))
195
196(def-type-prop-test last.1 'last '(list) 1)
197(def-type-prop-test last.2 'last '(list (integer 0 15)) 2)
198(def-type-prop-test last.3 'last '((cons t (or t (cons t (or t (cons t t)))))) 1)
199(def-type-prop-test last.4 'last '((cons t (or t (cons t (or t (cons t t))))) (integer 0 5)) 2)
200
201(def-type-prop-test ldiff.1 'ldiff '(list t) 2)
202(def-type-prop-test ldiff.2 'ldiff (list 'list
203                                         #'(lambda (x)
204                                             (if (consp x)
205                                                 `(or t (eql ,(nthcdr (random (length x)) x)))
206                                               t)))
207  2)
208
209(def-type-prop-test tailp.1 'tailp '(t list) 2)
210(def-type-prop-test tailp.2 'tailp (list t #'(lambda (x) (make-list-type (1+ (random 10)) `(eql ,x)))) 2)
211
212(def-type-prop-test nthcdr 'nthcdr '((integer 0 20) list) 2)
213
214(def-type-prop-test member.1 'member '(t list) 2)
215(def-type-prop-test member.2 'member
216  (list t #'(lambda (x) (make-list-type (random 5) `(cons (eql ,x) ,(make-list-type (random 5))))))
217  2)
218(def-type-prop-test member.3 'member `(t list (eql :key) (or (eql not) (eql ,#'not))) 4)
219(def-type-prop-test member.4 'member `(t list (eql :test) (or (eql equalp) (eql ,#'equalp))) 4)
220(def-type-prop-test member.5 'member `(t list (eql :test-not) (or (eql eql) (eql ,#'eql))) 4)
221(def-type-prop-test member.6 'member `(t list (eql :allow-other-keys) (and t (not null)) (eql :foo) t) 6)
222
223(def-type-prop-test member-if.1 'member-if `((or (eql symbolp) (eql ,#'symbolp)) list) 2)
224(def-type-prop-test member-if.2 'member-if
225  (list '(eql zerop) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10))))
226  2)
227(def-type-prop-test member-if.3 'member-if
228  (list '(eql zerop) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10)))
229        '(eql :key)`(or (eql 1-) (eql ,#'1-)))
230  4)
231
232(def-type-prop-test member-if-not.1 'member-if-not `((or (eql symbolp) (eql ,#'symbolp)) list) 2)
233(def-type-prop-test member-if-not.2 'member-if-not
234  (list '(eql plusp) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10))))
235  2)
236(def-type-prop-test member-if-not.3 'member-if-not
237  (list '(eql plusp)
238        #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10)))
239        '(eql :key)
240        `(or (eql 1-) (eql ,#'1-)))
241  4)
242(def-type-prop-test member-if-not.4 'member-if-not
243  `((eql identity) list
244    (eql :allow-other-keys) (and t (not null))
245    (member :foo :bar #:xyz) t)
246  6)
247
248(def-type-prop-test mapc.1 'mapc '((eql list)) 2 :rest-type 'list :maxargs 10)
249(def-type-prop-test mapc.2 'mapc `((eql ,#'values)) 2 :rest-type 'list :maxargs 10)
250
251(def-type-prop-test mapcar.1 'mapcar '((eql list)) 2 :rest-type 'list :maxargs 10)
252(def-type-prop-test mapcar.2 'mapcar `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
253
254(def-type-prop-test maplist.1 'maplist '((eql list)) 2 :rest-type 'list :maxargs 10)
255(def-type-prop-test maplist.2 'maplist `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
256
257(def-type-prop-test mapl.1 'mapl '((eql list)) 2 :rest-type 'list :maxargs 10)
258(def-type-prop-test mapl.2 'mapl `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
259
260(def-type-prop-test mapcan.1 'mapcan '((eql list)) 2 :rest-type 'list :maxargs 10)
261
262(def-type-prop-test mapcon.1 'mapcon '((eql copy-list) list) 2)
263
264(def-type-prop-test acons 'acons
265  (list t t #'(lambda (x y) (make-list-type (random 5) 'null '(or null (cons t t)))))
266  3)
267
268(def-type-prop-test assoc.1 'assoc (list t #'(lambda (x) (make-list-type (random 6) 'null '(or null (cons t t))))) 2)
269(def-type-prop-test assoc.2 'assoc
270  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons (eql ,x) t)))))
271  2)
272(def-type-prop-test assoc.3 'assoc
273  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons (eql ,x) t))))
274        '(eql :key) `(or (eql not) (eql ,#'not)))
275  4)
276(def-type-prop-test assoc.4 'assoc
277  (list 'real
278        #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons real t) (cons (eql ,x) t))))
279        `(member :test :test-not) `(member <= < = /= > >= ,#'<= ,#'< ,#'= ,#'/= ,#'> ,#'>=))
280  4)
281
282(def-type-prop-test assoc-if.1 'assoc-if
283  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
284        (make-list-type (random 8) 'null '(or null (cons t t))))
285  2)
286(def-type-prop-test assoc-if.2 'assoc-if
287  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
288        (make-list-type (random 8) 'null '(or null (cons real t)))
289        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
290  2)
291
292(def-type-prop-test assoc-if-not.1 'assoc-if-not
293  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
294        (make-list-type (random 8) 'null '(or null (cons t t))))
295  2)
296(def-type-prop-test assoc-if-not.2 'assoc-if-not
297  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
298        (make-list-type (random 8) 'null '(or null (cons real t)))
299        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
300  2)
301
302(def-type-prop-test copy-alist 'copy-alist
303  (list #'(lambda () (make-list-type (random 10) 'null '(or null (cons t t)))))
304  1)
305
306(def-type-prop-test pairlis.1 'pairlis
307  (list 'list #'(lambda (x) (make-list-type (length x) 'null t)))
308  2)
309
310(def-type-prop-test pairlis.2 'pairlis
311  (list 'list #'(lambda (x) (make-list-type (length x) 'null t))
312        #'(lambda (x y) (make-list-type (random 6) 'null '(or null (cons t t)))))
313  3)
314
315(def-type-prop-test rassoc.1 'rassoc (list t #'(lambda (x) (make-list-type (random 6) 'null '(or null (cons t t))))) 2)
316(def-type-prop-test rassoc.2 'rassoc
317  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons t (eql ,x))))))
318  2)
319(def-type-prop-test rassoc.3 'rassoc
320  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons t (eql ,x)))))
321        '(eql :key) `(or (eql not) (eql ,#'not)))
322  4)
323(def-type-prop-test rassoc.4 'rassoc
324  (list 'real
325        #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t real) (cons t (eql ,x)))))
326        `(member :test :test-not) `(member <= < = /= > >= ,#'<= ,#'< ,#'= ,#'/= ,#'> ,#'>=))
327  4)
328
329(def-type-prop-test rassoc-if.1 'rassoc-if
330  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
331        (make-list-type (random 8) 'null '(or null (cons t t))))
332  2)
333(def-type-prop-test rassoc-if.2 'rassoc-if
334  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
335        (make-list-type (random 8) 'null '(or null (cons t real)))
336        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
337  2)
338
339(def-type-prop-test rassoc-if-not.1 'rassoc-if-not
340  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
341        (make-list-type (random 8) 'null '(or null (cons t t))))
342  2)
343(def-type-prop-test rassoc-if-not.2 'rassoc-if-not
344  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
345        (make-list-type (random 8) 'null '(or null (cons t real)))
346        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
347  2)
348
349;;; We don't use numbers or characters as indicators, since the test is EQ,
350;;; which is not well-behaved on these types.
351
352(def-type-prop-test get-properties.1 'get-properties
353  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character)))) 'list)
354  2)
355(def-type-prop-test get-properties.2 'get-properties
356  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
357        #'(lambda (plist) (let ((len (length plist)))
358                            (if (= len 0) '(cons t null)
359                              (let ((ind (elt plist (* 2 (random (floor len 2))))))
360                                `(cons (eql ,ind) null))))))
361  2)
362
363(def-type-prop-test getf.1 'getf
364  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character)))) t)
365  2)
366(def-type-prop-test getf.2 'getf
367  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
368        #'(lambda (plist) (let ((len (length plist)))
369                            (if (= len 0) t
370                              (let ((ind (elt plist (* 2 (random (floor len 2))))))
371                                `(eql ,ind))))))
372  2)
373(def-type-prop-test getf.3 'getf
374  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
375        t t)
376  3)
377
378(def-type-prop-test intersection.1 'intersection '(list list) 2 :test #'same-set-p)
379(def-type-prop-test intersection.2 'intersection '(list list (eql :key) (eql identity))  4 :test #'same-set-p)
380(def-type-prop-test intersection.3 'intersection
381  (list #'(lambda () (make-list-type (random 10) 'null 'integer))
382        #'(lambda (x) (make-list-type (random 10) 'null 'integer))
383        '(eql :key)
384        `(member 1+ ,#'1+))
385  4
386  :test #'same-set-p)
387(def-type-prop-test intersection.4 'intersection
388  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
389        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
390        '(eql :key)
391        `(member car ,#'car))
392  4
393  :test #'(lambda (x y) (same-set-p x y :key #'car)))
394(def-type-prop-test intersection.5 'intersection
395  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
396        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
397        '(eql :test)
398        `(member equal ,#'equal))
399  4
400  :test #'(lambda (x y) (same-set-p x y :key #'car)))
401
402(def-type-prop-test nintersection.1 'nintersection '(list list) 2 :test #'same-set-p :replicate '(t t))
403(def-type-prop-test nintersection.2 'nintersection '(list list (eql :key) (eql identity))  4 :test #'same-set-p :replicate '(t t nil nil))
404(def-type-prop-test nintersection.3 'nintersection
405  (list #'(lambda () (make-list-type (random 10) 'null 'integer))
406        #'(lambda (x) (make-list-type (random 10) 'null 'integer))
407        '(eql :key)
408        `(member 1+ ,#'1+))
409  4
410  :test #'same-set-p
411  :replicate '(t t nil nil))
412(def-type-prop-test nintersection.4 'nintersection
413  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
414        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
415        '(eql :key)
416        `(member car ,#'car))
417  4
418  :test #'(lambda (x y) (same-set-p x y :key #'car))
419  :replicate '(t t nil nil))
420(def-type-prop-test nintersection.5 'nintersection
421  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
422        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
423        '(eql :test)
424        `(member equal ,#'equal))
425  4
426  :test #'(lambda (x y) (same-set-p x y :key #'car))
427  :replicate '(t t nil nil))
428
429
430(def-type-prop-test adjoin.1 'adjoin '(t list) 2)
431(def-type-prop-test adjoin.2 'adjoin '((integer 0 1) list) 2)
432(def-type-prop-test adjoin.3 'adjoin `((integer 0 10) (cons number (cons number (cons number null)))
433                                       (eql :test) (or (eql =) (eql ,#'=)))
434  4)
435(def-type-prop-test adjoin.4 'adjoin `(number
436                                       (cons number (cons number (cons number (cons number null))))
437                                       (eql :test-not) (or (eql /=) (eql ,#'/=)))
438  4)
439(def-type-prop-test adjoin.5 'adjoin `(number
440                                       (cons number (cons number (cons number (cons number null))))
441                                       (eql :key) (or (member 1+ 1- ,#'1+ ,#'1-)))
442  4)
443
444(def-type-prop-test pushnew.1 '(lambda (x y) (list (pushnew x y) y)) '(t list) 2)
445(def-type-prop-test pushnew.2 '(lambda (x y) (list (pushnew x y) y)) '((integer 0 1) list) 2)
446(def-type-prop-test pushnew.3 '(lambda (x y) (list (pushnew x y :test #'=) y))
447  `((integer 0 10) (cons number (cons number (cons number null))))
448  2)
449(def-type-prop-test pushnew.4 '(lambda (x y) (list (pushnew x y :test-not #'/=) y))
450  `((integer 0 10) (cons number (cons number (cons number null))))
451  2)
452(def-type-prop-test pushnew.5 '(lambda (x y) (list (pushnew x y :key #'1+) y))
453  `(number (cons number (cons number (cons number (cons number null)))))
454  2)
455
456(def-type-prop-test set-difference.1 'set-difference '(list list) 2)
457(def-type-prop-test set-difference.2 'set-difference '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
458                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
459  2)
460(def-type-prop-test set-difference.3 'set-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
461                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
462                                                       (eql :test) (member = ,#'=))
463  4)
464(def-type-prop-test set-difference.4 'set-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
465                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
466                                                       (eql :test-not) (member /= ,#'/=))
467  4)
468(def-type-prop-test set-difference.5 'set-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
469                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
470                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
471  4)
472
473(def-type-prop-test nset-difference.1 'nset-difference '(list list) 2 :replicate '(t t))
474(def-type-prop-test nset-difference.2 'nset-difference '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
475                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
476  2 :replicate '(t t))
477(def-type-prop-test nset-difference.3 'nset-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
478                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
479                                                       (eql :test) (member = ,#'=))
480  4 :replicate '(t t nil nil))
481(def-type-prop-test nset-difference.4 'nset-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
482                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
483                                                       (eql :test-not) (member /= ,#'/=))
484  4 :replicate '(t t nil nil))
485(def-type-prop-test nset-difference.5 'nset-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
486                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
487                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
488  4 :replicate '(t t nil nil))
489
490
491(def-type-prop-test set-exclusive-or.1 'set-exclusive-or '(list list) 2)
492(def-type-prop-test set-exclusive-or.2 'set-exclusive-or '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
493                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
494  2)
495(def-type-prop-test set-exclusive-or.3 'set-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
496                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
497                                                       (eql :test) (member = ,#'=))
498  4)
499(def-type-prop-test set-exclusive-or.4 'set-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
500                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
501                                                       (eql :test-not) (member /= ,#'/=))
502  4)
503(def-type-prop-test set-exclusive-or.5 'set-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
504                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
505                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
506  4)
507
508(def-type-prop-test nset-exclusive-or.1 'nset-exclusive-or '(list list) 2 :replicate '(t t))
509(def-type-prop-test nset-exclusive-or.2 'nset-exclusive-or '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
510                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
511  2 :replicate '(t t))
512(def-type-prop-test nset-exclusive-or.3 'nset-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
513                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
514                                                       (eql :test) (member = ,#'=))
515  4 :replicate '(t t nil nil))
516(def-type-prop-test nset-exclusive-or.4 'nset-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
517                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
518                                                       (eql :test-not) (member /= ,#'/=))
519  4 :replicate '(t t nil nil))
520(def-type-prop-test nset-exclusive-or.5 'nset-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
521                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
522                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
523  4 :replicate '(t t nil nil))
524
525(def-type-prop-test subsetp.1 'subsetp '(list list) 2)
526(def-type-prop-test subsetp.2 'subsetp '((cons integer null)
527                                         (cons integer (cons integer (cons integer (cons integer null)))))
528  2)
Note: See TracBrowser for help on using the repository browser.