source: trunk/source/tests/ansi-tests/count-if.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: 14.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Aug 20 08:01:30 2002
4;;;; Contains: Tests for COUNT-IF
5
6(in-package :cl-test)
7
8(deftest count-if-list.1
9  (count-if #'identity '(a b nil c d nil e))
10  5)
11
12(deftest count-if-list.2
13  (count-if #'not '(a b nil c d nil e))
14  2)
15
16(deftest count-if-list.3
17  (count-if #'(lambda (x) (break)) nil)
18  0)
19
20(deftest count-if-list.4
21  (count-if #'identity '(a b nil c d nil e) :key #'identity)
22  5)
23
24(deftest count-if-list.5
25  (count-if 'identity '(a b nil c d nil e) :key #'identity)
26  5)
27
28(deftest count-if-list.6
29  (count-if #'identity '(a b nil c d nil e) :key 'identity)
30  5)
31
32(deftest count-if-list.8
33  (count-if #'identity '(a b nil c d nil e) :key 'not)
34  2)
35
36(deftest count-if-list.9
37  (count-if #'evenp '(1 2 3 4 4 1 8 10 1))
38  5)
39
40(deftest count-if-list.10
41  (count-if #'evenp '(1 2 3 4 4 1 8 10 1) :key #'1+)
42  4)
43
44(deftest count-if-list.11
45  (let ((c 0))
46    (count-if #'evenp '(1 2 3 4 4 1 8 10 1)
47              :key #'(lambda (x) (+ x (incf c)))))
48  6)
49
50(deftest count-if-list.12
51  (let ((c 0))
52    (count-if #'evenp '(0 1 2 3 4 4 1 7 10 1)
53              :from-end t
54              :key #'(lambda (x) (+ x (incf c)))))
55  8)
56
57(deftest count-if-list.13
58  (count-if #'(lambda (x) (eqt x 'a))
59            '(a b c d a e f a e f f a a) :start 2)
60  4)
61
62(deftest count-if-list.14
63  (count-if #'(lambda (x) (eqt x 'a))
64            '(a b c d a e f a e f f a a) :end 7)
65  2)
66 
67(deftest count-if-list.15
68  (count-if #'(lambda (x) (eqt x 'a))
69            '(a b c d a e f a e f f a a) :end 7
70            :start 2)
71  1)
72 
73(deftest count-if-list.16
74  (count-if #'(lambda (x) (eqt x 'a))
75            '(a b c d a e f a e f f a a) :end 7
76            :start 2 :from-end t)
77  1)
78 
79
80;;; tests on vectors
81
82(deftest count-if-vector.1
83  (count-if #'identity #(a b nil c d nil e))
84  5)
85
86(deftest count-if-vector.2
87  (count-if #'not #(a b nil c d nil e))
88  2)
89
90(deftest count-if-vector.3
91  (count-if #'(lambda (x) (break)) #())
92  0)
93
94(deftest count-if-vector.4
95  (count-if #'identity #(a b nil c d nil e) :key #'identity)
96  5)
97
98(deftest count-if-vector.5
99  (count-if 'identity #(a b nil c d nil e) :key #'identity)
100  5)
101
102(deftest count-if-vector.6
103  (count-if #'identity #(a b nil c d nil e) :key 'identity)
104  5)
105
106(deftest count-if-vector.8
107  (count-if #'identity #(a b nil c d nil e) :key 'not)
108  2)
109
110(deftest count-if-vector.9
111  (count-if #'evenp #(1 2 3 4 4 1 8 10 1))
112  5)
113
114(deftest count-if-vector.10
115  (count-if #'evenp #(1 2 3 4 4 1 8 10 1) :key #'1+)
116  4)
117
118(deftest count-if-vector.11
119  (let ((c 0))
120    (count-if #'evenp #(1 2 3 4 4 1 8 10 1)
121              :key #'(lambda (x) (+ x (incf c)))))
122  6)
123
124(deftest count-if-vector.12
125  (let ((c 0))
126    (count-if #'evenp #(0 1 2 3 4 4 1 7 10 1)
127              :from-end t
128              :key #'(lambda (x) (+ x (incf c)))))
129  8)
130
131(deftest count-if-vector.13
132  (count-if #'(lambda (x) (eqt x 'a))
133            #(a b c d a e f a e f f a a) :start 2)
134  4)
135
136(deftest count-if-vector.14
137  (count-if #'(lambda (x) (eqt x 'a))
138            #(a b c d a e f a e f f a a) :end 7)
139  2)
140 
141(deftest count-if-vector.15
142  (count-if #'(lambda (x) (eqt x 'a))
143            #(a b c d a e f a e f f a a) :end 7
144            :start 2)
145  1)
146 
147(deftest count-if-vector.16
148  (count-if #'(lambda (x) (eqt x 'a))
149            #(a b c d a e f a e f f a a) :end 7
150            :start 2 :from-end t)
151  1)
152
153;;; Non-simple vectors
154
155(deftest count-if-nonsimple-vector.1
156  (count-if #'identity (make-array 7 :initial-contents '(a b nil c d nil e)
157                                   :fill-pointer t
158                                   :adjustable t))
159  5)
160
161(deftest count-if-nonsimple-vector.2
162  (count-if #'not (make-array 7 :initial-contents '(a b nil c d nil e)
163                                   :fill-pointer t
164                                   :adjustable t))
165  2)
166
167(deftest count-if-nonsimple-vector.3
168  (count-if #'(lambda (x) (break)) (make-array 0
169                                   :fill-pointer t
170                                   :adjustable t))
171  0)
172
173(deftest count-if-nonsimple-vector.4
174  (count-if #'identity
175            (make-array 7 :initial-contents '(a b nil c d nil e)
176                        :fill-pointer t
177                        :adjustable t)
178            :key #'identity)
179  5)
180
181(deftest count-if-nonsimple-vector.5
182  (count-if 'identity
183            (make-array 7 :initial-contents '(a b nil c d nil e)
184                        :fill-pointer t
185                        :adjustable t)
186            :key #'identity)
187  5)
188
189(deftest count-if-nonsimple-vector.6
190  (count-if #'identity
191            (make-array 7 :initial-contents '(a b nil c d nil e)
192                        :fill-pointer t
193                        :adjustable t)
194            :key 'identity)
195  5)
196
197(deftest count-if-nonsimple-vector.8
198  (count-if #'identity
199            (make-array 7 :initial-contents '(a b nil c d nil e)
200                        :fill-pointer t
201                        :adjustable t)
202            :key 'not)
203  2)
204
205(deftest count-if-nonsimple-vector.9
206  (count-if #'evenp (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1)
207                                :fill-pointer t :adjustable t))
208  5)
209
210(deftest count-if-nonsimple-vector.10
211  (count-if #'evenp
212            (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1)
213                        :fill-pointer t :adjustable t)
214            :key #'1+)
215  4)
216
217(deftest count-if-nonsimple-vector.11
218  (let ((c 0))
219    (count-if #'evenp
220              (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1)
221                          :fill-pointer t :adjustable t)
222              :key #'(lambda (x) (+ x (incf c)))))
223  6)
224
225(deftest count-if-nonsimple-vector.12
226  (let ((c 0))
227    (count-if #'evenp
228              (make-array 10 :initial-contents '(0 1 2 3 4 4 1 7 10 1)
229                          :fill-pointer t :adjustable t)
230              :from-end t
231              :key #'(lambda (x) (+ x (incf c)))))
232  8)
233
234(deftest count-if-nonsimple-vector.13
235  (count-if #'(lambda (x) (eqt x 'a))
236            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
237                        :fill-pointer t :adjustable t)
238            :start 2)
239  4)
240
241(deftest count-if-nonsimple-vector.14
242  (count-if #'(lambda (x) (eqt x 'a))
243            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
244                        :fill-pointer t :adjustable t)
245            :end 7)
246  2)
247 
248(deftest count-if-nonsimple-vector.15
249  (count-if #'(lambda (x) (eqt x 'a))
250            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
251                        :fill-pointer t :adjustable t)
252            :end 7 :start 2)
253  1)
254 
255(deftest count-if-nonsimple-vector.16
256  (count-if #'(lambda (x) (eqt x 'a))
257            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
258                        :fill-pointer t :adjustable t)
259            :end 7 :start 2 :from-end t)
260  1)
261
262(deftest count-if-nonsimple-vector.17
263  (flet ((%f (x) (eqt x 'a)))
264    (let ((s (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
265                         :fill-pointer 6)))
266      (values (count-if #'%f s)
267              (count-if #'%f s :end nil)
268              (count-if #'%f s :end 4)
269              (count-if #'%f s :start 1)
270              (count-if #'%f s :start 1 :end 4)
271              (count-if #'%f s :start 1 :end 4 :from-end t))))
272  2 2 1 1 0 0)
273
274;;; Other special vectors
275
276(deftest count-if.special-vector.1
277  (do-special-integer-vectors
278   (v #(1 0 1 1 1 0 1 1 1 0 1) nil)
279   (assert (eql (count-if #'plusp v) 8))
280   (assert (eql (count-if #'zerop v) 3))
281   (assert (eql (count-if #'plusp v :start 2) 7))
282   (assert (eql (count-if #'zerop v :end 9) 2)))
283  nil)
284
285(deftest count-if.special-vector.2
286  (do-special-integer-vectors
287   (v #(1 3 2 4 7 5 6 1 0 2 4) nil)
288   (assert (eql (count-if #'evenp v) 6))
289   (assert (eql (count-if #'oddp v) 5))
290   (assert (eql (count-if #'plusp v :start 2) 8))
291   (assert (eql (count-if #'zerop v :end 8) 0)))
292  nil)
293
294(deftest count-if.special-vector.3
295  (loop for etype in '(short-float single-float double-float long-float)
296        for vals = (loop for e in '(0 1 2 1 3 0 4 5 6 0)
297                         collect (coerce e etype))
298        for vec = (make-array (length vals) :element-type etype :initial-contents vals)
299        for result = (count-if #'zerop vec)
300        unless (= result 3)
301        collect (list etype vals vec result))
302  nil)
303
304(deftest count-if.special-vector.4
305  (loop for cetype in '(short-float single-float double-float long-float integer rational)
306        for etype = `(complex ,cetype)
307        for vals = (loop for e in '(6 1 2 1 3 -4 4 5 6 100)
308                         collect (complex 0 (coerce e cetype)))
309        for vec = (make-array (length vals) :element-type etype :initial-contents vals)
310        for result = (count-if #'(lambda (x) (< (abs x) 5/2)) vec)
311        unless (= result 3)
312        collect (list etype vals vec result))
313  nil)
314
315
316;;; tests on bit-vectors
317
318(deftest count-if-bit-vector.1
319  (count-if #'evenp #*001011101101)
320  5)
321
322(deftest count-if-bit-vector.2
323  (count-if #'identity #*001011101101)
324  12)
325
326(deftest count-if-bit-vector.3
327  (count-if #'(lambda (x) (break)) #*)
328  0)
329
330(deftest count-if-bit-vector.4
331  (count-if #'identity #*001011101101 :key #'zerop)
332  5)
333
334(deftest count-if-bit-vector.5
335  (count-if 'identity #*001011101101 :key #'zerop)
336  5)
337
338(deftest count-if-bit-vector.6
339  (count-if #'identity #*001011101101 :key 'zerop)
340  5)
341
342(deftest count-if-bit-vector.8
343  (count-if #'identity #*001011101101 :key 'oddp)
344  7)
345
346(deftest count-if-bit-vector.10
347  (count-if #'evenp #*001011101101 :key #'1+)
348  7)
349
350(deftest count-if-bit-vector.11
351  (let ((c 0))
352    (count-if #'evenp #*001011101101
353              :key #'(lambda (x) (+ x (incf c)))))
354  7)
355
356(deftest count-if-bit-vector.12
357  (let ((c 0))
358    (count-if #'evenp #*001011101101
359              :from-end t
360              :key #'(lambda (x) (+ x (incf c)))))
361  5)
362
363(deftest count-if-bit-vector.13
364  (count-if #'zerop #*0111011011100 :start 2)
365  4)
366
367(deftest count-if-bit-vector.14
368  (count-if #'zerop #*0111011011100 :end 7)
369  2)
370 
371(deftest count-if-bit-vector.15
372  (count-if #'zerop #*0111011011100 :end 7 :start 2)
373  1)
374 
375(deftest count-if-bit-vector.16
376  (count-if #'zerop #*0111011011100 :end 7 :start 2 :from-end t)
377  1)
378
379(deftest count-if-bit-vector.17
380  (let ((s (make-array '(10) :initial-contents '(0 0 1 0 1 0 0 1 1 0)
381                       :element-type 'bit
382                       :fill-pointer 6)))
383    (values (count-if #'zerop s)
384            (count-if #'zerop s :end nil)
385            (count-if #'zerop s :end 4)
386            (count-if #'zerop s :start 5)
387            (count-if #'zerop s :start 1 :end 4)))
388  4 4 3 1 2)
389
390;;; tests on strings
391
392(deftest count-if-string.1
393  (count-if #'(lambda (x) (eql x #\0)) "001011101101")
394  5)
395
396(deftest count-if-string.2
397  (count-if #'identity "001011101101")
398  12)
399
400(deftest count-if-string.3
401  (count-if #'(lambda (x) (break)) "")
402  0)
403
404(deftest count-if-string.4
405  (count-if #'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
406  5)
407
408(deftest count-if-string.5
409  (count-if 'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
410  5)
411
412(deftest count-if-string.6
413  (count-if #'(lambda (x) (eql x #\0)) "001011101101" :key 'identity)
414  5)
415
416(deftest count-if-string.8
417  (count-if #'identity "001011101101" :key #'(lambda (x) (eql x #\1)))
418  7)
419
420(deftest count-if-string.11
421  (let ((c 0))
422    (count-if #'evenp "001011101101"
423              :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
424  7)
425
426(deftest count-if-string.12
427  (let ((c 0))
428    (count-if #'evenp "001011101101"
429              :from-end t
430              :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
431  5)
432
433(deftest count-if-string.13
434  (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :start 2)
435  4)
436
437(deftest count-if-string.14
438  (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :end 7)
439  2)
440 
441(deftest count-if-string.15
442  (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :end 7 :start 2)
443  1)
444 
445(deftest count-if-string.16
446  (count-if #'(lambda (x) (eql x #\0))
447            "0111011011100" :end 7 :start 2 :from-end t)
448  1)
449
450(deftest count-if-string.17
451  (let ((s (make-array '(10)
452                       :initial-contents "00a0aa0a0a"
453                       :element-type 'character
454                       :fill-pointer 6)))
455    (values (count-if #'digit-char-p s)
456            (count-if #'digit-char-p s :end nil)
457            (count-if #'digit-char-p s :start 1)
458            (count-if #'digit-char-p s :end 2)
459            (count-if #'digit-char-p s :start 1 :end 2)))
460  3 3 2 2 1)
461
462(deftest count-if-string.18
463  (do-special-strings
464   (s "1abC3!?deZ" nil)
465   (assert (= (count-if #'alpha-char-p s) 6)))
466  nil)
467
468;;; Argument order tests
469
470(deftest count-if.order.1
471  (let ((i 0) c1 c2 c3 c4 c5 c6)
472    (values
473     (count-if (progn (setf c1 (incf i)) #'null)
474               (progn (setf c2 (incf i)) '(a nil b c nil d e))
475               :start (progn (setf c3 (incf i)) 0)
476               :end (progn (setf c4 (incf i)) 3)
477               :key (progn (setf c5 (incf i)) #'identity)
478               :from-end (progn (setf c6 (incf i)) nil)
479               )
480     i c1 c2 c3 c4 c5 c6))
481  1 6 1 2 3 4 5 6)
482
483(deftest count-if.order.2
484  (let ((i 0) c1 c2 c3 c4 c5 c6)
485    (values
486     (count-if (progn (setf c1 (incf i)) #'null)
487               (progn (setf c2 (incf i)) '(a nil b c nil d e))
488               :from-end (progn (setf c3 (incf i)) nil)
489               :key (progn (setf c4 (incf i)) #'identity)
490               :end (progn (setf c5 (incf i)) 3)
491               :start (progn (setf c6 (incf i)) 0)
492               )
493     i c1 c2 c3 c4 c5 c6))
494  1 6 1 2 3 4 5 6)
495
496
497;;; Keyword tests
498
499(deftest count-if.allow-other-keys.1
500  (count-if #'evenp '(1 2 3 4 5) :bad t :allow-other-keys t)
501  2)
502
503(deftest count-if.allow-other-keys.2
504  (count-if #'evenp '(1 2 3 4 5) :allow-other-keys #p"*" :also-bad t)
505  2)
506
507;;; The leftmost of two :allow-other-keys arguments is the one that  matters.
508(deftest count-if.allow-other-keys.3
509  (count-if #'evenp '(1 2 3 4 5)
510            :allow-other-keys t
511            :allow-other-keys nil
512            :bad t)
513  2)
514
515(deftest count-if.keywords.4
516  (count-if #'evenp '(1 2 3 4 5) :key #'identity :key #'1+)
517  2)
518
519(deftest count-if.allow-other-keys.5
520  (count-if #'evenp '(1 2 3 4 5) :allow-other-keys nil)
521  2)
522
523           
524;;; Error tests
525
526(deftest count-if.error.1
527  (check-type-error #'(lambda (x) (count-if #'identity x))
528                    #'sequencep)
529  nil)
530
531(deftest count-if.error.4
532  (signals-error (count-if) program-error)
533  t)
534
535(deftest count-if.error.5
536  (signals-error (count-if #'null) program-error)
537  t)
538
539(deftest count-if.error.6
540  (signals-error (count-if #'null nil :bad t) program-error)
541  t)
542
543(deftest count-if.error.7
544  (signals-error (count-if #'null nil :bad t :allow-other-keys nil)
545                 program-error)
546  t)
547
548(deftest count-if.error.8
549  (signals-error (count-if #'null nil :key) program-error)
550  t)
551
552(deftest count-if.error.9
553  (signals-error (count-if #'null nil 3 3) program-error)
554  t)
555
556;;; Only leftmost :allow-other-keys argument matters
557(deftest count-if.error.10
558  (signals-error (count-if #'null nil :bad t
559                            :allow-other-keys nil
560                            :allow-other-keys t)
561                 program-error)
562  t)
563
564(deftest count-if.error.11
565  (signals-error (locally (count-if #'identity 1) t) type-error)
566  t)
567
568(deftest count-if.error.12
569  (signals-error (count-if #'cons '(a b c)) program-error)
570  t)
571
572(deftest count-if.error.13
573  (signals-error (count-if #'car '(a b c)) type-error)
574  t)
575
576(deftest count-if.error.14
577  (signals-error (count-if #'identity '(a b c) :key #'cdr)
578                 type-error)
579  t)
580
581(deftest count-if.error.15
582  (signals-error (count-if #'identity '(a b c) :key #'cons)
583                 program-error)
584  t)
Note: See TracBrowser for help on using the repository browser.