1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sun Mar 13 18:31:57 2005 |
---|
4 | ;;;; Contains: Random type prop tests, part 8 (sequences) |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (def-type-prop-test copy-seq 'copy-seq '((or vector list)) 1) |
---|
9 | |
---|
10 | (def-type-prop-test elt 'elt (list '(or vector list) |
---|
11 | #'(lambda (x) (let ((len (length x))) |
---|
12 | (and (> len 0) `(integer 0 (,len)))))) |
---|
13 | 2) |
---|
14 | |
---|
15 | (defmacro rfill (x y &rest other-args) |
---|
16 | `(fill ,y ,x ,@other-args)) |
---|
17 | |
---|
18 | (def-type-prop-test fill.1 'rfill |
---|
19 | (list t #'make-random-sequence-type-containing) |
---|
20 | 2 :replicate '(nil t)) |
---|
21 | |
---|
22 | (def-type-prop-test fill.2 'rfill |
---|
23 | (list 'integer #'make-random-sequence-type-containing) |
---|
24 | 2 :replicate '(nil t)) |
---|
25 | |
---|
26 | (def-type-prop-test fill.3 'rfill |
---|
27 | (list 'character #'make-random-sequence-type-containing) |
---|
28 | 2 :replicate '(nil t)) |
---|
29 | |
---|
30 | (def-type-prop-test fill.4 'rfill |
---|
31 | (list t #'make-random-sequence-type-containing |
---|
32 | '(eql :start) |
---|
33 | #'(lambda (v s k1) (declare (ignore v k1)) |
---|
34 | (let ((len (length s))) |
---|
35 | `(integer 0 ,len)))) |
---|
36 | 4 :replicate '(nil t nil nil)) |
---|
37 | |
---|
38 | (def-type-prop-test fill.5 'rfill |
---|
39 | (list t #'make-random-sequence-type-containing |
---|
40 | '(eql :end) |
---|
41 | #'(lambda (v s k1) (declare (ignore v k1)) |
---|
42 | (let ((len (length s))) |
---|
43 | `(integer 0 ,len)))) |
---|
44 | 4 :replicate '(nil t nil nil)) |
---|
45 | |
---|
46 | (def-type-prop-test fill.6 'rfill |
---|
47 | (list t #'make-random-sequence-type-containing |
---|
48 | '(eql :start) |
---|
49 | #'(lambda (v s k1) (declare (ignore v k1)) |
---|
50 | (let ((len (length s))) |
---|
51 | `(integer 0 ,len))) |
---|
52 | '(eql :end) |
---|
53 | #'(lambda (v s k1 start k2) |
---|
54 | (declare (ignore v k1 k2)) |
---|
55 | (let ((len (length s))) |
---|
56 | `(integer ,start ,len)))) |
---|
57 | 6 :replicate '(nil t nil nil nil nil)) |
---|
58 | |
---|
59 | ;;; make-sequence tests here |
---|
60 | |
---|
61 | (def-type-prop-test subseq.1 'subseq |
---|
62 | (list 'sequence #'(lambda (s) `(integer 0 ,(length s)))) |
---|
63 | 2) |
---|
64 | |
---|
65 | (def-type-prop-test subseq.2 'subseq |
---|
66 | (list 'sequence #'(lambda (s) `(integer 0 ,(length s))) |
---|
67 | #'(lambda (s start) `(integer ,start ,(length s)))) |
---|
68 | 3) |
---|
69 | |
---|
70 | ;;; map tests here |
---|
71 | |
---|
72 | (def-type-prop-test map.1 'map |
---|
73 | (list '(member list vector) |
---|
74 | '(member list #.#'list) |
---|
75 | '(or list vector)) |
---|
76 | 3) |
---|
77 | |
---|
78 | (def-type-prop-test map.2 'map |
---|
79 | (list '(member list vector) |
---|
80 | '(member list #.#'list) |
---|
81 | '(or list vector) |
---|
82 | '(or list vector)) |
---|
83 | 4) |
---|
84 | |
---|
85 | (def-type-prop-test map.3 'map |
---|
86 | (list '(member list vector) |
---|
87 | '(member list #.#'list) |
---|
88 | '(or list vector) |
---|
89 | '(or list vector) |
---|
90 | '(or list vector)) |
---|
91 | 5) |
---|
92 | |
---|
93 | (def-type-prop-test map.4 'map |
---|
94 | (list '(member list vector (vector (unsigned-byte 32))) |
---|
95 | '(member 1+ #.#'1+) |
---|
96 | `(or ,@(loop for i from 1 to 31 collect `(vector (unsigned-byte ,i))))) |
---|
97 | 3) |
---|
98 | |
---|
99 | (def-type-prop-test map.5 'map |
---|
100 | (list `(member ,@(loop for i from 1 to 32 collect `(vector (unsigned-byte ,i)))) |
---|
101 | '(member 1+ #.#'1+) |
---|
102 | #'(lambda (type fun) |
---|
103 | (declare (ignore fun)) |
---|
104 | (let ((i (cadadr type))) |
---|
105 | `(or ,@(loop for j from i to 32 collect `(vector (integer 0 ,(- (ash 1 i) 2)))))))) |
---|
106 | 3) |
---|
107 | |
---|
108 | |
---|
109 | |
---|
110 | ;;; map-into tests here |
---|
111 | |
---|
112 | (def-type-prop-test map-into.1 'map-into |
---|
113 | (list '(or list (vector t)) |
---|
114 | '(member list #.#'list) |
---|
115 | '(or list vector)) |
---|
116 | 3 :replicate '(t nil nil)) |
---|
117 | |
---|
118 | (def-type-prop-test map-into.2 'map-into |
---|
119 | (list '(or list (vector t)) |
---|
120 | '(member list #.#'list) |
---|
121 | '(or list vector) |
---|
122 | '(or list vector)) |
---|
123 | 4 :replicate '(t nil nil nil)) |
---|
124 | |
---|
125 | ;;; reduce tests here |
---|
126 | |
---|
127 | (def-type-prop-test count.1 'count '(t sequence) 2) |
---|
128 | (def-type-prop-test count.2 'count |
---|
129 | (list t #'make-random-sequence-type-containing) |
---|
130 | 2) |
---|
131 | (def-type-prop-test count.3 'count |
---|
132 | (list t #'make-random-sequence-type-containing |
---|
133 | '(eql :start) |
---|
134 | #'(lambda (x s k1) (declare (ignore x k1)) |
---|
135 | `(integer 0 ,(length s)))) |
---|
136 | 4) |
---|
137 | (def-type-prop-test count.4 'count |
---|
138 | (list t #'make-random-sequence-type-containing |
---|
139 | '(eql :end) |
---|
140 | #'(lambda (x s k1) (declare (ignore x k1)) |
---|
141 | `(integer 0 ,(length s)))) |
---|
142 | 4) |
---|
143 | (def-type-prop-test count.5 'count |
---|
144 | (list t #'make-random-sequence-type-containing |
---|
145 | '(eql :start) |
---|
146 | #'(lambda (x s k1) (declare (ignore x k1)) |
---|
147 | `(integer 0 ,(length s))) |
---|
148 | '(eql :end) |
---|
149 | #'(lambda (x s k1 start k2) (declare (ignore x k1 k2)) |
---|
150 | `(integer ,start ,(length s)))) |
---|
151 | 6) |
---|
152 | |
---|
153 | (def-type-prop-test count.6 'count |
---|
154 | (list '(or short-float single-float double-float long-float) |
---|
155 | #'(lambda (f) `(vector (or ,(typecase f |
---|
156 | (short-float 'short-float) |
---|
157 | (single-float 'single-float) |
---|
158 | (double-float 'double-float) |
---|
159 | (long-float 'long-float) |
---|
160 | (t 'float)) |
---|
161 | (eql ,f))))) |
---|
162 | 2) |
---|
163 | |
---|
164 | (def-type-prop-test count.7 'count '(bit (vector bit)) 2) |
---|
165 | (def-type-prop-test count.8 'count '((unsigned-byte 2) (vector (unsigned-byte 2))) 2) |
---|
166 | (def-type-prop-test count.9 'count '((unsigned-byte 4) (vector (unsigned-byte 4))) 2) |
---|
167 | (def-type-prop-test count.10 'count '((unsigned-byte 8) (vector (unsigned-byte 8))) 2) |
---|
168 | |
---|
169 | |
---|
170 | ;;; count-if tests |
---|
171 | |
---|
172 | (def-type-prop-test count-if.1 'count-if |
---|
173 | (list (let ((funs '(numberp rationalp realp floatp complexp |
---|
174 | symbolp identity null functionp listp consp |
---|
175 | arrayp vectorp simple-vector-p |
---|
176 | stringp simple-string-p |
---|
177 | bit-vector-p simple-bit-vector-p))) |
---|
178 | `(member ,@funs ,@(mapcar #'symbol-function funs))) |
---|
179 | '(or list vector)) |
---|
180 | 2) |
---|
181 | |
---|
182 | (def-type-prop-test count-if.2 'count-if |
---|
183 | (list (let ((funs '(numberp rationalp realp floatp complexp |
---|
184 | symbolp identity null functionp listp consp |
---|
185 | arrayp vectorp simple-vector-p |
---|
186 | stringp simple-string-p |
---|
187 | bit-vector-p simple-bit-vector-p))) |
---|
188 | `(member ,@funs ,@(mapcar #'symbol-function funs))) |
---|
189 | '(or list vector) |
---|
190 | '(eql :key) |
---|
191 | (let ((key-funs '(identity not null))) |
---|
192 | `(member ,@key-funs ,@(mapcar #'symbol-function key-funs)))) |
---|
193 | 4) |
---|
194 | |
---|
195 | |
---|
196 | ;;; Put count-if-not tests here |
---|
197 | |
---|
198 | |
---|
199 | (def-type-prop-test length.1 'length '(sequence) 1) |
---|
200 | |
---|
201 | (def-type-prop-test reverse.1 'reverse '(sequence) 1) |
---|
202 | (def-type-prop-test nreverse.1 'nreverse '(sequence) 1 :replicate '(t)) |
---|
203 | |
---|
204 | (def-type-prop-test sort.1 'sort |
---|
205 | `((vector bit) (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) 2 |
---|
206 | :replicate '(t nil)) |
---|
207 | |
---|
208 | (def-type-prop-test sort.2 'sort |
---|
209 | `((or (vector (unsigned-byte 2)) |
---|
210 | (vector (unsigned-byte 3)) |
---|
211 | (vector (unsigned-byte 4)) |
---|
212 | (vector (unsigned-byte 5)) |
---|
213 | (vector (unsigned-byte 6)) |
---|
214 | (vector (unsigned-byte 7)) |
---|
215 | (vector (unsigned-byte 8))) |
---|
216 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
217 | 2 :replicate '(t nil)) |
---|
218 | |
---|
219 | (def-type-prop-test sort.3 'sort |
---|
220 | `((or (vector (unsigned-byte 10)) |
---|
221 | (vector (unsigned-byte 13)) |
---|
222 | (vector (unsigned-byte 15)) |
---|
223 | (vector (unsigned-byte 16))) |
---|
224 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
225 | 2 :replicate '(t nil)) |
---|
226 | |
---|
227 | (def-type-prop-test sort.4 'sort |
---|
228 | `((or (vector (unsigned-byte 20)) |
---|
229 | (vector (unsigned-byte 24)) |
---|
230 | (vector (unsigned-byte 28)) |
---|
231 | (vector (unsigned-byte 31)) |
---|
232 | (vector (unsigned-byte 32))) |
---|
233 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
234 | 2 :replicate '(t nil)) |
---|
235 | |
---|
236 | (def-type-prop-test sort.5 'sort |
---|
237 | `((or (vector (signed-byte 2)) |
---|
238 | (vector (signed-byte 3)) |
---|
239 | (vector (signed-byte 4)) |
---|
240 | (vector (signed-byte 5)) |
---|
241 | (vector (signed-byte 6)) |
---|
242 | (vector (signed-byte 7)) |
---|
243 | (vector (signed-byte 8))) |
---|
244 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
245 | 2 :replicate '(t nil)) |
---|
246 | |
---|
247 | (def-type-prop-test sort.6 'sort |
---|
248 | `((or (vector (signed-byte 10)) |
---|
249 | (vector (signed-byte 13)) |
---|
250 | (vector (signed-byte 15)) |
---|
251 | (vector (signed-byte 16))) |
---|
252 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
253 | 2 :replicate '(t nil)) |
---|
254 | |
---|
255 | (def-type-prop-test sort.7 'sort |
---|
256 | `((or (vector (signed-byte 20)) |
---|
257 | (vector (signed-byte 24)) |
---|
258 | (vector (signed-byte 28)) |
---|
259 | (vector (signed-byte 31)) |
---|
260 | (vector (signed-byte 32))) |
---|
261 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
262 | 2 :replicate '(t nil)) |
---|
263 | |
---|
264 | (def-type-prop-test sort.8 'sort |
---|
265 | `((or (vector short-float) |
---|
266 | (vector single-float) |
---|
267 | (vector double-float) |
---|
268 | (vector long-float)) |
---|
269 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
270 | 2 :replicate '(t nil)) |
---|
271 | |
---|
272 | ;;; Stable sort |
---|
273 | |
---|
274 | (def-type-prop-test stable-sort.1 'stable-sort |
---|
275 | `((vector bit) (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) 2 |
---|
276 | :replicate '(t nil)) |
---|
277 | |
---|
278 | (def-type-prop-test stable-sort.2 'stable-sort |
---|
279 | `((or (vector (unsigned-byte 2)) |
---|
280 | (vector (unsigned-byte 3)) |
---|
281 | (vector (unsigned-byte 4)) |
---|
282 | (vector (unsigned-byte 5)) |
---|
283 | (vector (unsigned-byte 6)) |
---|
284 | (vector (unsigned-byte 7)) |
---|
285 | (vector (unsigned-byte 8))) |
---|
286 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
287 | 2 :replicate '(t nil)) |
---|
288 | |
---|
289 | (def-type-prop-test stable-sort.3 'stable-sort |
---|
290 | `((or (vector (unsigned-byte 10)) |
---|
291 | (vector (unsigned-byte 13)) |
---|
292 | (vector (unsigned-byte 15)) |
---|
293 | (vector (unsigned-byte 16))) |
---|
294 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
295 | 2 :replicate '(t nil)) |
---|
296 | |
---|
297 | (def-type-prop-test stable-sort.4 'stable-sort |
---|
298 | `((or (vector (unsigned-byte 20)) |
---|
299 | (vector (unsigned-byte 24)) |
---|
300 | (vector (unsigned-byte 28)) |
---|
301 | (vector (unsigned-byte 31)) |
---|
302 | (vector (unsigned-byte 32))) |
---|
303 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
304 | 2 :replicate '(t nil)) |
---|
305 | |
---|
306 | (def-type-prop-test stable-sort.5 'stable-sort |
---|
307 | `((or (vector (signed-byte 2)) |
---|
308 | (vector (signed-byte 3)) |
---|
309 | (vector (signed-byte 4)) |
---|
310 | (vector (signed-byte 5)) |
---|
311 | (vector (signed-byte 6)) |
---|
312 | (vector (signed-byte 7)) |
---|
313 | (vector (signed-byte 8))) |
---|
314 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
315 | 2 :replicate '(t nil)) |
---|
316 | |
---|
317 | (def-type-prop-test stable-sort.6 'stable-sort |
---|
318 | `((or (vector (signed-byte 10)) |
---|
319 | (vector (signed-byte 13)) |
---|
320 | (vector (signed-byte 15)) |
---|
321 | (vector (signed-byte 16))) |
---|
322 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
323 | 2 :replicate '(t nil)) |
---|
324 | |
---|
325 | (def-type-prop-test stable-sort.7 'stable-sort |
---|
326 | `((or (vector (signed-byte 20)) |
---|
327 | (vector (signed-byte 24)) |
---|
328 | (vector (signed-byte 28)) |
---|
329 | (vector (signed-byte 31)) |
---|
330 | (vector (signed-byte 32))) |
---|
331 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
332 | 2 :replicate '(t nil)) |
---|
333 | |
---|
334 | (def-type-prop-test stable-sort.8 'stable-sort |
---|
335 | `((or (vector short-float) |
---|
336 | (vector single-float) |
---|
337 | (vector double-float) |
---|
338 | (vector long-float)) |
---|
339 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) |
---|
340 | 2 :replicate '(t nil)) |
---|
341 | |
---|
342 | (def-type-prop-test stable-sort.9 'stable-sort |
---|
343 | `((vector (cons (integer 0 4) (eql nil))) |
---|
344 | (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=) |
---|
345 | (eql :key) |
---|
346 | (member car ,#'car)) |
---|
347 | 4 :replicate '(t nil nil nil) |
---|
348 | :test #'equalp-and-eql-elements) |
---|