count-if.lsp 15.4 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Aug 20 08:01:30 2002
;;;; Contains: Tests for COUNT-IF

(in-package :cl-test)

(deftest count-if-list.1
  (count-if #'identity '(a b nil c d nil e))
  5)

(deftest count-if-list.2
  (count-if #'not '(a b nil c d nil e))
  2)

(deftest count-if-list.3
  (count-if #'(lambda (x) (break)) nil)
  0)

(deftest count-if-list.4
  (count-if #'identity '(a b nil c d nil e) :key #'identity)
  5)

(deftest count-if-list.5
  (count-if 'identity '(a b nil c d nil e) :key #'identity)
  5)

(deftest count-if-list.6
  (count-if #'identity '(a b nil c d nil e) :key 'identity)
  5)

(deftest count-if-list.8
  (count-if #'identity '(a b nil c d nil e) :key 'not)
  2)

(deftest count-if-list.9
  (count-if #'evenp '(1 2 3 4 4 1 8 10 1))
  5)

(deftest count-if-list.10
  (count-if #'evenp '(1 2 3 4 4 1 8 10 1) :key #'1+)
  4)

(deftest count-if-list.11
  (let ((c 0))
    (count-if #'evenp '(1 2 3 4 4 1 8 10 1)
sds's avatar
sds committed
47
              :key #'(lambda (x) (+ x (incf c)))))
48
49
50
51
52
  6)

(deftest count-if-list.12
  (let ((c 0))
    (count-if #'evenp '(0 1 2 3 4 4 1 7 10 1)
sds's avatar
sds committed
53
54
              :from-end t
              :key #'(lambda (x) (+ x (incf c)))))
55
56
57
  8)

(deftest count-if-list.13
58
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
59
            '(a b c d a e f a e f f a a) :start 2)
60
61
62
  4)

(deftest count-if-list.14
63
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
64
            '(a b c d a e f a e f f a a) :end 7)
65
  2)
sds's avatar
sds committed
66

67
(deftest count-if-list.15
68
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
69
70
            '(a b c d a e f a e f f a a) :end 7
            :start 2)
71
  1)
sds's avatar
sds committed
72

73
(deftest count-if-list.16
74
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
75
76
            '(a b c d a e f a e f f a a) :end 7
            :start 2 :from-end t)
77
  1)
sds's avatar
sds committed
78

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

;;; tests on vectors

(deftest count-if-vector.1
  (count-if #'identity #(a b nil c d nil e))
  5)

(deftest count-if-vector.2
  (count-if #'not #(a b nil c d nil e))
  2)

(deftest count-if-vector.3
  (count-if #'(lambda (x) (break)) #())
  0)

(deftest count-if-vector.4
  (count-if #'identity #(a b nil c d nil e) :key #'identity)
  5)

(deftest count-if-vector.5
  (count-if 'identity #(a b nil c d nil e) :key #'identity)
  5)

(deftest count-if-vector.6
  (count-if #'identity #(a b nil c d nil e) :key 'identity)
  5)

(deftest count-if-vector.8
  (count-if #'identity #(a b nil c d nil e) :key 'not)
  2)

(deftest count-if-vector.9
  (count-if #'evenp #(1 2 3 4 4 1 8 10 1))
  5)

(deftest count-if-vector.10
  (count-if #'evenp #(1 2 3 4 4 1 8 10 1) :key #'1+)
  4)

(deftest count-if-vector.11
  (let ((c 0))
    (count-if #'evenp #(1 2 3 4 4 1 8 10 1)
sds's avatar
sds committed
121
              :key #'(lambda (x) (+ x (incf c)))))
122
123
124
125
126
  6)

(deftest count-if-vector.12
  (let ((c 0))
    (count-if #'evenp #(0 1 2 3 4 4 1 7 10 1)
sds's avatar
sds committed
127
128
              :from-end t
              :key #'(lambda (x) (+ x (incf c)))))
129
130
131
  8)

(deftest count-if-vector.13
132
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
133
            #(a b c d a e f a e f f a a) :start 2)
134
135
136
  4)

(deftest count-if-vector.14
137
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
138
            #(a b c d a e f a e f f a a) :end 7)
139
  2)
sds's avatar
sds committed
140

141
(deftest count-if-vector.15
142
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
143
144
            #(a b c d a e f a e f f a a) :end 7
            :start 2)
145
  1)
sds's avatar
sds committed
146

147
(deftest count-if-vector.16
148
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
149
150
            #(a b c d a e f a e f f a a) :end 7
            :start 2 :from-end t)
151
152
153
154
155
156
  1)

;;; Non-simple vectors

(deftest count-if-nonsimple-vector.1
  (count-if #'identity (make-array 7 :initial-contents '(a b nil c d nil e)
sds's avatar
sds committed
157
158
                                   :fill-pointer t
                                   :adjustable t))
159
160
161
162
  5)

(deftest count-if-nonsimple-vector.2
  (count-if #'not (make-array 7 :initial-contents '(a b nil c d nil e)
sds's avatar
sds committed
163
164
                                   :fill-pointer t
                                   :adjustable t))
165
166
167
168
  2)

(deftest count-if-nonsimple-vector.3
  (count-if #'(lambda (x) (break)) (make-array 0
sds's avatar
sds committed
169
170
                                   :fill-pointer t
                                   :adjustable t))
171
172
173
174
  0)

(deftest count-if-nonsimple-vector.4
  (count-if #'identity
sds's avatar
sds committed
175
176
177
178
            (make-array 7 :initial-contents '(a b nil c d nil e)
                        :fill-pointer t
                        :adjustable t)
            :key #'identity)
179
180
181
182
  5)

(deftest count-if-nonsimple-vector.5
  (count-if 'identity
sds's avatar
sds committed
183
184
185
186
            (make-array 7 :initial-contents '(a b nil c d nil e)
                        :fill-pointer t
                        :adjustable t)
            :key #'identity)
187
188
189
190
  5)

(deftest count-if-nonsimple-vector.6
  (count-if #'identity
sds's avatar
sds committed
191
192
193
194
            (make-array 7 :initial-contents '(a b nil c d nil e)
                        :fill-pointer t
                        :adjustable t)
            :key 'identity)
195
196
197
198
  5)

(deftest count-if-nonsimple-vector.8
  (count-if #'identity
sds's avatar
sds committed
199
200
201
202
            (make-array 7 :initial-contents '(a b nil c d nil e)
                        :fill-pointer t
                        :adjustable t)
            :key 'not)
203
204
205
206
  2)

(deftest count-if-nonsimple-vector.9
  (count-if #'evenp (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1)
sds's avatar
sds committed
207
                                :fill-pointer t :adjustable t))
208
209
210
211
  5)

(deftest count-if-nonsimple-vector.10
  (count-if #'evenp
sds's avatar
sds committed
212
213
214
            (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1)
                        :fill-pointer t :adjustable t)
            :key #'1+)
215
216
217
218
219
  4)

(deftest count-if-nonsimple-vector.11
  (let ((c 0))
    (count-if #'evenp
sds's avatar
sds committed
220
221
222
              (make-array 9 :initial-contents '(1 2 3 4 4 1 8 10 1)
                          :fill-pointer t :adjustable t)
              :key #'(lambda (x) (+ x (incf c)))))
223
224
225
226
227
  6)

(deftest count-if-nonsimple-vector.12
  (let ((c 0))
    (count-if #'evenp
sds's avatar
sds committed
228
229
230
231
              (make-array 10 :initial-contents '(0 1 2 3 4 4 1 7 10 1)
                          :fill-pointer t :adjustable t)
              :from-end t
              :key #'(lambda (x) (+ x (incf c)))))
232
233
234
  8)

(deftest count-if-nonsimple-vector.13
235
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
236
237
238
            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
                        :fill-pointer t :adjustable t)
            :start 2)
239
240
241
  4)

(deftest count-if-nonsimple-vector.14
242
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
243
244
245
            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
                        :fill-pointer t :adjustable t)
            :end 7)
246
  2)
sds's avatar
sds committed
247

248
(deftest count-if-nonsimple-vector.15
249
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
250
251
252
            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
                        :fill-pointer t :adjustable t)
            :end 7 :start 2)
253
  1)
sds's avatar
sds committed
254

255
(deftest count-if-nonsimple-vector.16
256
  (count-if #'(lambda (x) (eqt x 'a))
sds's avatar
sds committed
257
258
259
            (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
                        :fill-pointer t :adjustable t)
            :end 7 :start 2 :from-end t)
260
261
  1)

262
263
264
(deftest count-if-nonsimple-vector.17
  (flet ((%f (x) (eqt x 'a)))
    (let ((s (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
sds's avatar
sds committed
265
                         :fill-pointer 6)))
266
      (values (count-if #'%f s)
sds's avatar
sds committed
267
268
269
270
271
              (count-if #'%f s :end nil)
              (count-if #'%f s :end 4)
              (count-if #'%f s :start 1)
              (count-if #'%f s :start 1 :end 4)
              (count-if #'%f s :start 1 :end 4 :from-end t))))
272
273
  2 2 1 1 0 0)

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
;;; Other special vectors

(deftest count-if.special-vector.1
  (do-special-integer-vectors
   (v #(1 0 1 1 1 0 1 1 1 0 1) nil)
   (assert (eql (count-if #'plusp v) 8))
   (assert (eql (count-if #'zerop v) 3))
   (assert (eql (count-if #'plusp v :start 2) 7))
   (assert (eql (count-if #'zerop v :end 9) 2)))
  nil)

(deftest count-if.special-vector.2
  (do-special-integer-vectors
   (v #(1 3 2 4 7 5 6 1 0 2 4) nil)
   (assert (eql (count-if #'evenp v) 6))
   (assert (eql (count-if #'oddp v) 5))
   (assert (eql (count-if #'plusp v :start 2) 8))
   (assert (eql (count-if #'zerop v :end 8) 0)))
  nil)

(deftest count-if.special-vector.3
  (loop for etype in '(short-float single-float double-float long-float)
sds's avatar
sds committed
296
297
298
299
300
301
        for vals = (loop for e in '(0 1 2 1 3 0 4 5 6 0)
                         collect (coerce e etype))
        for vec = (make-array (length vals) :element-type etype :initial-contents vals)
        for result = (count-if #'zerop vec)
        unless (= result 3)
        collect (list etype vals vec result))
302
303
304
305
  nil)

(deftest count-if.special-vector.4
  (loop for cetype in '(short-float single-float double-float long-float integer rational)
sds's avatar
sds committed
306
307
308
309
310
311
312
        for etype = `(complex ,cetype)
        for vals = (loop for e in '(6 1 2 1 3 -4 4 5 6 100)
                         collect (complex 0 (coerce e cetype)))
        for vec = (make-array (length vals) :element-type etype :initial-contents vals)
        for result = (count-if #'(lambda (x) (< (abs x) 5/2)) vec)
        unless (= result 3)
        collect (list etype vals vec result))
313
314
315
  nil)


316
317
318
;;; tests on bit-vectors

(deftest count-if-bit-vector.1
319
320
321
  (count-if #'evenp #*001011101101)
  5)

322
(deftest count-if-bit-vector.2
323
324
325
  (count-if #'identity #*001011101101)
  12)

326
(deftest count-if-bit-vector.3
327
328
329
  (count-if #'(lambda (x) (break)) #*)
  0)

330
(deftest count-if-bit-vector.4
331
332
333
  (count-if #'identity #*001011101101 :key #'zerop)
  5)

334
(deftest count-if-bit-vector.5
335
336
337
  (count-if 'identity #*001011101101 :key #'zerop)
  5)

338
(deftest count-if-bit-vector.6
339
340
341
  (count-if #'identity #*001011101101 :key 'zerop)
  5)

342
(deftest count-if-bit-vector.8
343
344
345
  (count-if #'identity #*001011101101 :key 'oddp)
  7)

346
(deftest count-if-bit-vector.10
347
348
349
  (count-if #'evenp #*001011101101 :key #'1+)
  7)

350
(deftest count-if-bit-vector.11
351
352
  (let ((c 0))
    (count-if #'evenp #*001011101101
sds's avatar
sds committed
353
              :key #'(lambda (x) (+ x (incf c)))))
354
355
  7)

356
(deftest count-if-bit-vector.12
357
358
  (let ((c 0))
    (count-if #'evenp #*001011101101
sds's avatar
sds committed
359
360
              :from-end t
              :key #'(lambda (x) (+ x (incf c)))))
361
362
  5)

363
(deftest count-if-bit-vector.13
364
365
366
  (count-if #'zerop #*0111011011100 :start 2)
  4)

367
(deftest count-if-bit-vector.14
368
369
  (count-if #'zerop #*0111011011100 :end 7)
  2)
sds's avatar
sds committed
370

371
(deftest count-if-bit-vector.15
372
373
  (count-if #'zerop #*0111011011100 :end 7 :start 2)
  1)
sds's avatar
sds committed
374

375
(deftest count-if-bit-vector.16
376
377
378
  (count-if #'zerop #*0111011011100 :end 7 :start 2 :from-end t)
  1)

379
380
(deftest count-if-bit-vector.17
  (let ((s (make-array '(10) :initial-contents '(0 0 1 0 1 0 0 1 1 0)
sds's avatar
sds committed
381
382
                       :element-type 'bit
                       :fill-pointer 6)))
383
    (values (count-if #'zerop s)
sds's avatar
sds committed
384
385
386
387
            (count-if #'zerop s :end nil)
            (count-if #'zerop s :end 4)
            (count-if #'zerop s :start 5)
            (count-if #'zerop s :start 1 :end 4)))
388
389
  4 4 3 1 2)

390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
;;; tests on strings

(deftest count-if-string.1
  (count-if #'(lambda (x) (eql x #\0)) "001011101101")
  5)

(deftest count-if-string.2
  (count-if #'identity "001011101101")
  12)

(deftest count-if-string.3
  (count-if #'(lambda (x) (break)) "")
  0)

(deftest count-if-string.4
  (count-if #'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
  5)

(deftest count-if-string.5
  (count-if 'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
  5)

(deftest count-if-string.6
  (count-if #'(lambda (x) (eql x #\0)) "001011101101" :key 'identity)
  5)

(deftest count-if-string.8
  (count-if #'identity "001011101101" :key #'(lambda (x) (eql x #\1)))
  7)

(deftest count-if-string.11
  (let ((c 0))
    (count-if #'evenp "001011101101"
sds's avatar
sds committed
423
              :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
424
425
426
427
428
  7)

(deftest count-if-string.12
  (let ((c 0))
    (count-if #'evenp "001011101101"
sds's avatar
sds committed
429
430
              :from-end t
              :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
431
432
433
434
435
436
437
438
439
  5)

(deftest count-if-string.13
  (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :start 2)
  4)

(deftest count-if-string.14
  (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :end 7)
  2)
sds's avatar
sds committed
440

441
442
443
(deftest count-if-string.15
  (count-if #'(lambda (x) (eql x #\0)) "0111011011100" :end 7 :start 2)
  1)
sds's avatar
sds committed
444

445
446
(deftest count-if-string.16
  (count-if #'(lambda (x) (eql x #\0))
sds's avatar
sds committed
447
            "0111011011100" :end 7 :start 2 :from-end t)
448
449
  1)

450
451
(deftest count-if-string.17
  (let ((s (make-array '(10)
sds's avatar
sds committed
452
453
454
                       :initial-contents "00a0aa0a0a"
                       :element-type 'character
                       :fill-pointer 6)))
455
    (values (count-if #'digit-char-p s)
sds's avatar
sds committed
456
457
458
459
            (count-if #'digit-char-p s :end nil)
            (count-if #'digit-char-p s :start 1)
            (count-if #'digit-char-p s :end 2)
            (count-if #'digit-char-p s :start 1 :end 2)))
460
  3 3 2 2 1)
461

462
463
464
465
466
467
(deftest count-if-string.18
  (do-special-strings
   (s "1abC3!?deZ" nil)
   (assert (= (count-if #'alpha-char-p s) 6)))
  nil)

468
469
;;; Argument order tests

470
(deftest count-if.order.1
471
472
473
  (let ((i 0) c1 c2 c3 c4 c5 c6)
    (values
     (count-if (progn (setf c1 (incf i)) #'null)
sds's avatar
sds committed
474
475
476
477
478
479
               (progn (setf c2 (incf i)) '(a nil b c nil d e))
               :start (progn (setf c3 (incf i)) 0)
               :end (progn (setf c4 (incf i)) 3)
               :key (progn (setf c5 (incf i)) #'identity)
               :from-end (progn (setf c6 (incf i)) nil)
               )
480
481
482
     i c1 c2 c3 c4 c5 c6))
  1 6 1 2 3 4 5 6)

483
(deftest count-if.order.2
484
485
486
  (let ((i 0) c1 c2 c3 c4 c5 c6)
    (values
     (count-if (progn (setf c1 (incf i)) #'null)
sds's avatar
sds committed
487
488
489
490
491
492
               (progn (setf c2 (incf i)) '(a nil b c nil d e))
               :from-end (progn (setf c3 (incf i)) nil)
               :key (progn (setf c4 (incf i)) #'identity)
               :end (progn (setf c5 (incf i)) 3)
               :start (progn (setf c6 (incf i)) 0)
               )
493
494
495
496
     i c1 c2 c3 c4 c5 c6))
  1 6 1 2 3 4 5 6)


497
;;; Keyword tests
498
499
500
501
502
503
504
505
506
507
508
509

(deftest count-if.allow-other-keys.1
  (count-if #'evenp '(1 2 3 4 5) :bad t :allow-other-keys t)
  2)

(deftest count-if.allow-other-keys.2
  (count-if #'evenp '(1 2 3 4 5) :allow-other-keys #p"*" :also-bad t)
  2)

;;; The leftmost of two :allow-other-keys arguments is the one that  matters.
(deftest count-if.allow-other-keys.3
  (count-if #'evenp '(1 2 3 4 5)
sds's avatar
sds committed
510
511
512
            :allow-other-keys t
            :allow-other-keys nil
            :bad t)
513
514
  2)

515
(deftest count-if.keywords.4
516
517
518
  (count-if #'evenp '(1 2 3 4 5) :key #'identity :key #'1+)
  2)

519
520
521
(deftest count-if.allow-other-keys.5
  (count-if #'evenp '(1 2 3 4 5) :allow-other-keys nil)
  2)
522

sds's avatar
sds committed
523

524
525
;;; Error tests

526
(deftest count-if.error.1
527
  (check-type-error #'(lambda (x) (count-if #'identity x))
sds's avatar
sds committed
528
                    #'sequencep)
529
  nil)
530
531

(deftest count-if.error.4
532
533
  (signals-error (count-if) program-error)
  t)
534
535

(deftest count-if.error.5
536
537
  (signals-error (count-if #'null) program-error)
  t)
538
539

(deftest count-if.error.6
540
541
  (signals-error (count-if #'null nil :bad t) program-error)
  t)
542
543

(deftest count-if.error.7
544
  (signals-error (count-if #'null nil :bad t :allow-other-keys nil)
sds's avatar
sds committed
545
                 program-error)
546
  t)
547
548

(deftest count-if.error.8
549
550
  (signals-error (count-if #'null nil :key) program-error)
  t)
551
552

(deftest count-if.error.9
553
554
  (signals-error (count-if #'null nil 3 3) program-error)
  t)
555
556
557

;;; Only leftmost :allow-other-keys argument matters
(deftest count-if.error.10
558
  (signals-error (count-if #'null nil :bad t
sds's avatar
sds committed
559
560
561
                            :allow-other-keys nil
                            :allow-other-keys t)
                 program-error)
562
  t)
563
564

(deftest count-if.error.11
565
566
  (signals-error (locally (count-if #'identity 1) t) type-error)
  t)
567
568

(deftest count-if.error.12
569
570
  (signals-error (count-if #'cons '(a b c)) program-error)
  t)
571
572

(deftest count-if.error.13
573
574
  (signals-error (count-if #'car '(a b c)) type-error)
  t)
575
576

(deftest count-if.error.14
577
  (signals-error (count-if #'identity '(a b c) :key #'cdr)
sds's avatar
sds committed
578
                 type-error)
579
  t)
580
581

(deftest count-if.error.15
582
  (signals-error (count-if #'identity '(a b c) :key #'cons)
sds's avatar
sds committed
583
                 program-error)
584
  t)