source: trunk/source/tests/ansi-tests/count-if-not.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.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Aug 20 22:42:35 2002
4;;;; Contains: Tests for COUNT-IF-NOT
5
6(in-package :cl-test)
7
8(deftest count-if-not-list.1
9  (count-if-not #'identity '(a b nil c d nil e))
10  2)
11
12(deftest count-if-not-list.2
13  (count-if-not #'not '(a b nil c d nil e))
14  5)
15
16(deftest count-if-not-list.3
17  (count-if-not #'(lambda (x) (break)) nil)
18  0)
19
20(deftest count-if-not-list.4
21  (count-if-not #'identity '(a b nil c d nil e) :key #'identity)
22  2)
23
24(deftest count-if-not-list.5
25  (count-if-not 'identity '(a b nil c d nil e) :key #'identity)
26  2)
27
28(deftest count-if-not-list.6
29  (count-if-not #'identity '(a b nil c d nil e) :key 'identity)
30  2)
31
32(deftest count-if-not-list.8
33  (count-if-not #'identity '(a b nil c d nil e) :key 'not)
34  5)
35
36(deftest count-if-not-list.9
37  (count-if-not #'oddp '(1 2 3 4 4 1 8 10 1))
38  5)
39
40(deftest count-if-not-list.10
41  (count-if-not #'oddp '(1 2 3 4 4 1 8 10 1) :key #'1+)
42  4)
43
44(deftest count-if-not-list.11
45  (let ((c 0))
46    (count-if-not #'oddp '(1 2 3 4 4 1 8 10 1)
47              :key #'(lambda (x) (+ x (incf c)))))
48  6)
49
50(deftest count-if-not-list.12
51  (let ((c 0))
52    (count-if-not #'oddp '(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-not-list.13
58  (count-if-not #'(lambda (x) (not (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-not-list.14
63  (count-if-not #'(lambda (x) (not (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-not-list.15
68  (count-if-not #'(lambda (x) (not (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-not-list.16
74  (count-if-not #'(lambda (x) (not (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-not-vector.1
83  (count-if-not #'identity #(a b nil c d nil e))
84  2)
85
86(deftest count-if-not-vector.2
87  (count-if-not #'not #(a b nil c d nil e))
88  5)
89
90(deftest count-if-not-vector.3
91  (count-if-not #'(lambda (x) (break)) #())
92  0)
93
94(deftest count-if-not-vector.4
95  (count-if-not #'not #(a b nil c d nil e) :key #'identity)
96  5)
97
98(deftest count-if-not-vector.5
99  (count-if-not 'not #(a b nil c d nil e) :key #'identity)
100  5)
101
102(deftest count-if-not-vector.6
103  (count-if-not #'not #(a b nil c d nil e) :key 'identity)
104  5)
105
106(deftest count-if-not-vector.8
107  (count-if-not #'not #(a b nil c d nil e) :key 'not)
108  2)
109
110(deftest count-if-not-vector.9
111  (count-if-not #'oddp #(1 2 3 4 4 1 8 10 1))
112  5)
113
114(deftest count-if-not-vector.10
115  (count-if-not #'oddp #(1 2 3 4 4 1 8 10 1) :key #'1+)
116  4)
117
118(deftest count-if-not-vector.11
119  (let ((c 0))
120    (count-if-not #'oddp #(1 2 3 4 4 1 8 10 1)
121              :key #'(lambda (x) (+ x (incf c)))))
122  6)
123
124(deftest count-if-not-vector.12
125  (let ((c 0))
126    (count-if-not #'oddp #(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-not-vector.13
132  (count-if-not #'(lambda (x) (not (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-not-vector.14
137  (count-if-not #'(lambda (x) (not (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-not-vector.15
142  (count-if-not #'(lambda (x) (not (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-not-vector.16
148  (count-if-not #'(lambda (x) (not (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-not-nonsimple-vector.1
156  (count-if-not #'identity (make-array 7 :initial-contents '(a b nil c d nil e)
157                                       :fill-pointer t
158                                       :adjustable t))
159  2)
160
161(deftest count-if-not-nonsimple-vector.2
162  (count-if-not #'not (make-array 7 :initial-contents '(a b nil c d nil e)
163                                  :fill-pointer t
164                                  :adjustable t))
165  5)
166
167(deftest count-if-not-nonsimple-vector.3
168  (count-if-not #'(lambda (x) (break)) (make-array 0
169                                                   :fill-pointer t
170                                                   :adjustable t))
171  0)
172
173(deftest count-if-not-nonsimple-vector.4
174  (count-if-not #'not
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-not-nonsimple-vector.5
182  (count-if-not 'not
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-not-nonsimple-vector.6
190  (count-if-not #'not
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-not-nonsimple-vector.8
198  (count-if-not #'not
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-not-nonsimple-vector.9
206  (count-if-not #'oddp (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-not-nonsimple-vector.10
211  (count-if-not #'oddp
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-not-nonsimple-vector.11
218  (let ((c 0))
219    (count-if-not #'oddp
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-not-nonsimple-vector.12
226  (let ((c 0))
227    (count-if-not #'oddp
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-not-nonsimple-vector.13
235  (count-if-not #'(lambda (x) (not (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-not-nonsimple-vector.14
242  (count-if-not #'(lambda (x) (not (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-not-nonsimple-vector.15
249  (count-if-not #'(lambda (x) (not (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-not-nonsimple-vector.16
256  (count-if-not #'(lambda (x) (not (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-not-nonsimple-vector.17
263  (flet ((%a (c) (not (eqt c 'a)))
264         (%f (c) (not (eqt c 'f))))
265    (let ((a (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
266                         :fill-pointer 9)))
267      (values (count-if-not #'%a a)
268              (count-if-not #'%a a :from-end t)
269              (count-if-not #'%f a)
270              (count-if-not #'%f a :from-end t)
271              )))
272  3 3 1 1)
273
274;;; Other special vectors
275
276`(deftest count-if-not.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-not #'plusp v) 3))
280   (assert (eql (count-if-not #'zerop v) 8))
281   (assert (eql (count-if-not #'plusp v :start 2) 2))
282   (assert (eql (count-if-not #'zerop v :end 9) 7)))
283  nil)
284
285(deftest count-if-not.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-not #'evenp v) 5))
289   (assert (eql (count-if-not #'oddp v) 6))
290   (assert (eql (count-if-not #'plusp v :start 2) 1))
291   (assert (eql (count-if-not #'zerop v :end 8) 8)))
292  nil)
293
294(deftest count-if-not.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-not #'zerop vec)
300        unless (= result 7)
301        collect (list etype vals vec result))
302  nil)
303
304(deftest count-if-not.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-not #'(lambda (x) (< (abs x) 5/2)) vec)
311        unless (= result 7)
312        collect (list etype vals vec result))
313  nil)
314
315
316;;; tests on bit-vectors
317
318(deftest count-if-not-bit-vector.1
319  (count-if-not #'oddp #*001011101101)
320  5)
321
322(deftest count-if-not-bit-vector.2
323  (count-if-not #'identity #*001011101101)
324  0)
325
326(deftest count-if-not-bit-vector.3
327  (count-if-not #'(lambda (x) (break)) #*)
328  0)
329
330(deftest count-if-not-bit-vector.4
331  (count-if-not #'identity #*001011101101 :key #'zerop)
332  7)
333
334(deftest count-if-not-bit-vector.5
335  (count-if-not 'not #*001011101101 :key #'zerop)
336  5)
337
338(deftest count-if-not-bit-vector.6
339  (count-if-not #'not #*001011101101 :key 'zerop)
340  5)
341
342(deftest count-if-not-bit-vector.8
343  (count-if-not #'identity #*001011101101 :key 'oddp)
344  5)
345
346(deftest count-if-not-bit-vector.10
347  (count-if-not #'oddp #*001011101101 :key #'1+)
348  7)
349
350(deftest count-if-not-bit-vector.11
351  (let ((c 0))
352    (count-if-not #'oddp #*001011101101
353                  :key #'(lambda (x) (+ x (incf c)))))
354  7)
355
356(deftest count-if-not-bit-vector.12
357  (let ((c 0))
358    (count-if-not #'oddp #*001011101101
359              :from-end t
360              :key #'(lambda (x) (+ x (incf c)))))
361  5)
362
363(deftest count-if-not-bit-vector.13
364  (count-if-not #'zerop #*0111011011100 :start 2)
365  7)
366
367(deftest count-if-not-bit-vector.14
368  (count-if-not #'zerop #*0111011011100 :end 7)
369  5)
370 
371(deftest count-if-not-bit-vector.15
372  (count-if-not #'zerop #*0111011011100 :end 7 :start 2)
373  4)
374 
375(deftest count-if-not-bit-vector.16
376  (count-if-not #'zerop #*0111011011100 :end 7 :start 2 :from-end t)
377  4)
378
379(deftest count-if-not-bit-vector.17
380  (let ((a (make-array '(10) :initial-contents '(0 0 0 1 1 1 0 1 0 0)
381                       :fill-pointer 5
382                       :element-type 'bit)))
383    (and (bit-vector-p a)
384         (values (count-if-not #'zerop a)
385                 (count-if-not #'oddp a)
386                 (count-if-not #'zerop a :from-end t)
387                 (count-if-not #'oddp a :from-end t))))
388  2 3 2 3)
389
390;;; tests on strings
391
392(deftest count-if-not-string.1
393  (count-if-not #'(lambda (x) (eql x #\0)) "001011101101")
394  7)
395
396(deftest count-if-not-string.2
397  (count-if-not #'identity "001011101101")
398  0)
399
400(deftest count-if-not-string.3
401  (count-if-not #'(lambda (x) (break)) "")
402  0)
403
404(deftest count-if-not-string.4
405  (count-if-not #'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
406  7)
407
408(deftest count-if-not-string.5
409  (count-if-not 'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
410  7)
411
412(deftest count-if-not-string.6
413  (count-if-not #'(lambda (x) (eql x #\0)) "001011101101" :key 'identity)
414  7)
415
416(deftest count-if-not-string.8
417  (count-if-not #'identity "001011101101" :key #'(lambda (x) (eql x #\1)))
418  5)
419
420(deftest count-if-not-string.11
421  (let ((c 0))
422    (count-if-not #'oddp "001011101101"
423                  :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
424  7)
425
426(deftest count-if-not-string.12
427  (let ((c 0))
428    (count-if-not #'oddp "001011101101"
429                  :from-end t
430                  :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
431  5)
432
433(deftest count-if-not-string.13
434  (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :start 2)
435  7)
436
437(deftest count-if-not-string.14
438  (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :end 7)
439  5)
440 
441(deftest count-if-not-string.15
442  (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :end 7 :start 2)
443  4)
444 
445(deftest count-if-not-string.16
446  (count-if-not #'(lambda (x) (eql x #\0))
447                "0111011011100" :end 7 :start 2 :from-end t)
448  4)
449
450(deftest count-if-not-string.17
451  (flet ((%zerop (c) (eql c #\0))
452         (%onep (c) (eql c #\1)))
453    (let ((a (make-array '(10) :initial-contents "0001110100"
454                         :fill-pointer 5
455                         :element-type 'character)))
456      (and (stringp a)
457           (values (count-if-not #'%zerop a)
458                   (count-if-not #'%onep a)
459                   (count-if-not #'%zerop a :from-end t)
460                   (count-if-not #'%onep a :from-end t)))))
461  2 3 2 3)
462
463(deftest count-if-not-string.18
464  (do-special-strings
465   (s "a1ha^%&%#( 873ff83nfa!" nil)
466   (assert (= (count-if-not #'alpha-char-p s) 14)))
467  nil)
468
469;;; Argument order tests
470
471(deftest count-if-not.order.1
472  (let ((i 0) c1 c2 c3 c4 c5 c6)
473    (values
474     (count-if-not
475      (progn (setf c1 (incf i)) #'null)
476      (progn (setf c2 (incf i)) '(a nil b c nil d e))
477      :start (progn (setf c3 (incf i)) 0)
478      :end (progn (setf c4 (incf i)) 3)
479      :key (progn (setf c5 (incf i)) #'not)
480      :from-end (progn (setf c6 (incf i)) nil)
481      )
482     i c1 c2 c3 c4 c5 c6))
483  1 6 1 2 3 4 5 6)
484
485(deftest count-if-not.order.2
486  (let ((i 0) c1 c2 c3 c4 c5 c6)
487    (values
488     (count-if-not
489      (progn (setf c1 (incf i)) #'null)
490      (progn (setf c2 (incf i)) '(a nil b c nil d e))
491      :from-end (progn (setf c3 (incf i)) nil)
492      :key (progn (setf c4 (incf i)) #'not)
493      :end (progn (setf c5 (incf i)) 3)
494      :start (progn (setf c6 (incf i)) 0)
495      )
496     i c1 c2 c3 c4 c5 c6))
497  1 6 1 2 3 4 5 6)
498
499;;; Keyword tests
500
501(deftest count-if-not.keywords.1
502  (count-if-not #'oddp '(1 2 3 4 5) :bad t :allow-other-keys t)
503  2)
504
505(deftest count-if-not.keywords.2
506  (count-if-not #'oddp '(1 2 3 4 5) :allow-other-keys #p"*" :also-bad t)
507  2)
508
509;;; The leftmost of two :allow-other-keys arguments is the one that  matters.
510(deftest count-if-not.keywords.3
511  (count-if-not #'oddp '(1 2 3 4 5)
512            :allow-other-keys t
513            :allow-other-keys nil
514            :bad t)
515  2)
516
517(deftest count-if-not.keywords.4
518  (count-if-not #'oddp '(1 2 3 4 5) :key #'identity :key #'1+)
519  2)
520
521(deftest count-if-not.allow-other-keys.5
522  (count-if-not #'null '(nil a b c nil) :allow-other-keys nil)
523  3)
524
525;;; Error tests
526
527(deftest count-if-not.error.1
528  (check-type-error #'(lambda (x) (count-if-not #'identity x)) #'sequencep)
529  nil)
530
531(deftest count-if-not.error.4
532  (signals-error (count-if-not) program-error)
533  t)
534
535(deftest count-if-not.error.5
536  (signals-error (count-if-not #'null) program-error)
537  t)
538
539(deftest count-if-not.error.6
540  (signals-error (count-if-not #'null nil :bad t) program-error)
541  t)
542
543(deftest count-if-not.error.7
544  (signals-error (count-if-not #'null nil :bad t :allow-other-keys nil)
545                 program-error)
546  t)
547
548(deftest count-if-not.error.8
549  (signals-error (count-if-not #'null nil :key) program-error)
550  t)
551
552(deftest count-if-not.error.9
553  (signals-error (count-if-not #'null nil 3 3) program-error)
554  t)
555
556;;; Only leftmost :allow-other-keys argument matters
557(deftest count-if-not.error.10
558  (signals-error (count-if-not #'null nil :bad t
559                                :allow-other-keys nil
560                                :allow-other-keys t)
561                 program-error)
562  t)
563
564(deftest count-if-not.error.11
565  (signals-error (locally (count-if-not #'identity 1) t)
566                 type-error)
567  t)
568
569(deftest count-if-not.error.12
570  (signals-error (count-if-not #'cons '(a b c)) program-error)
571  t)
572
573(deftest count-if-not.error.13
574  (signals-error (count-if-not #'car '(a b c)) type-error)
575  t)
576
577(deftest count-if-not.error.14
578  (signals-error (count-if-not #'identity '(a b c) :key #'cdr)
579                 type-error)
580  t)
581
582(deftest count-if-not.error.15
583  (signals-error (count-if-not #'identity '(a b c) :key #'cons)
584                 program-error)
585  t)
Note: See TracBrowser for help on using the repository browser.