source: trunk/source/tests/ansi-tests/random-type-prop-tests-08.lsp @ 8991

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

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

File size: 9.6 KB
RevLine 
[8991]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)
Note: See TracBrowser for help on using the repository browser.