source: trunk/source/tests/ansi-tests/count.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: 15.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Aug 19 07:31:55 2002
4;;;; Contains: Tests for COUNT
5
6(in-package :cl-test)
7
8(deftest count-list.1
9  (count 'a '(a b c d e a e f))
10  2)
11
12(deftest count-list.2
13  (count 'a '(a b c d e a e f) :test #'eql)
14  2)
15
16(deftest count-list.3
17  (count 'a '(a b c d e a e f) :test 'eql)
18  2)
19
20(deftest count-list.4
21  (count 1 '(1 2 2 3 2 1 2 2 5 4) :key #'1-)
22  5)
23
24(deftest count-list.5
25  (count 1 '(1 2 2 3 2 1 2 2 5 4) :key '1-)
26  5)
27
28(deftest count-list.6
29  (count 1 '(1 2 2 3 2 1 2 2 5 4) :key #'1- :test #'equal)
30  5)
31
32(deftest count-list.7
33  (count 1 '(2 1 1 2 3 1 4 1 7 6 1 8) :from-end t)
34  5)
35
36(deftest count-list.8
37  (let ((c 0))
38    (count 1 '(1 2 3 1 4 1 7 6 1 8)
39           :key #'(lambda (x)
40                    ;; (format t "~%~A ~A" x c)
41                    (prog1 (- x c) (incf c)))))
42  4)
43
44(deftest count-list.9
45  (let ((c 0))
46    (count 1 '(1 2 3 7 4 5 7 6 2 8)
47           :from-end t
48           :key #'(lambda (x)
49                    ;; (format t "~%~A ~A" x c)
50                    (prog1 (- x c) (incf c)))))
51  3)
52
53(deftest count-list.10
54  (count 1 '(1 1 1 1 1 2 1 1) :start 3)
55  4)
56
57(deftest count-list.11
58  (count 1 '(1 1 1 1 1 2 1 1) :end 6)
59  5)
60
61(deftest count-list.12
62  (count 1 '(1 1 1 1 1 2 1 1) :start 2 :end 7)
63  4)
64
65(deftest count-list.13
66  (count 1 '(1 1 1 1 1 2 1 1) :start 3 :end nil)
67  4)
68
69(deftest count-list.14
70  (count 1 '(1 1 1 1 1 2 1 1)  :end nil)
71  7)
72
73(deftest count-list.15
74  (count 1 '(1 1 1 1 1 2 1 1)  :test-not #'eql)
75  1)
76
77(deftest count-list.16
78  (count 1 '(1 1 1 3 1 2 1 1) :start 2 :end 7
79         :test #'(lambda (x y) (declare (ignore x y))  t))
80  5)
81
82(deftest count-list.17
83  (count 10 '(1 11 2 4 14 5 18 6 7) :test #'<)
84  3)
85
86(deftest count-list.18
87  (count 10 '(1 11 2 4 14 5 18 6 7) :test-not #'>=)
88  3)
89
90(defharmless count-list.test-and-test-not.1
91  (count 0 '(0 1 2 0 1 2 3 0 1) :test #'eql :test-not #'eql))
92
93(defharmless count-list.test-and-test-not.2
94  (count 0 '(0 1 2 0 1 2 3 0 1) :test-not #'eql :test #'eql))
95
96;;; On vectors
97
98(deftest count-vector.1
99  (count 'a #(a b c d e a e f))
100  2)
101
102(deftest count-vector.2
103  (count 'a #(a b c d e a e f) :test #'eql)
104  2)
105
106(deftest count-vector.3
107  (count 'a #(a b c d e a e f) :test 'eql)
108  2)
109
110(deftest count-vector.4
111  (count 1 #(1 2 2 3 2 1 2 2 5 4) :key #'1-)
112  5)
113
114(deftest count-vector.5
115  (count 1 #(1 2 2 3 2 1 2 2 5 4) :key '1-)
116  5)
117
118(deftest count-vector.6
119  (count 1 #(1 2 2 3 2 1 2 2 5 4) :key #'1- :test #'equal)
120  5)
121
122(deftest count-vector.7
123  (count 1 #(2 1 1 2 3 1 4 1 7 6 1 8) :from-end t)
124  5)
125
126(deftest count-vector.8
127  (let ((c 0))
128    (count 1 #(1 2 3 1 4 1 7 6 1 8)
129           :key #'(lambda (x)
130                    ;; (format t "~%~A ~A" x c)
131                    (prog1 (- x c) (incf c)))))
132  4)
133
134(deftest count-vector.9
135  (let ((c 0))
136    (count 1 #(1 2 3 7 4 5 7 6 2 8)
137           :from-end t
138           :key #'(lambda (x)
139                    ;; (format t "~%~A ~A" x c)
140                    (prog1 (- x c) (incf c)))))
141  3)
142
143(deftest count-vector.10
144  (count 1 #(1 1 1 1 1 2 1 1) :start 3)
145  4)
146
147(deftest count-vector.11
148  (count 1 #(1 1 1 1 1 2 1 1) :end 6)
149  5)
150
151(deftest count-vector.12
152  (count 1 #(1 1 1 1 1 2 1 1) :start 2 :end 7)
153  4)
154
155(deftest count-vector.13
156  (count 1 #(1 1 1 1 1 2 1 1) :start 3 :end nil)
157  4)
158
159(deftest count-vector.14
160  (count 1 #(1 1 1 1 1 2 1 1)  :end nil)
161  7)
162
163(deftest count-vector.15
164  (count 1 #(1 1 1 1 1 2 1 1)  :test-not #'eql)
165  1)
166
167(deftest count-vector.16
168  (count 1 #(1 1 1 3 1 2 1 1) :start 2 :end 7
169         :test #'(lambda (x y) (declare (ignore x y)) t))
170  5)
171
172(deftest count-vector.17
173  (count 10 #(1 11 2 4 14 5 18 6 7) :test #'<)
174  3)
175
176(deftest count-vector.18
177  (count 10 #(1 11 2 4 14 5 18 6 7) :test-not #'>=)
178  3)
179
180(defharmless count-vector.test-and-test-not.1
181  (count 0 #(0 1 2 0 1 2 3 0 1) :test #'eql :test-not #'eql))
182
183(defharmless count-vector.test-and-test-not.2
184  (count 0 #(0 1 2 0 1 2 3 0 1) :test-not #'eql :test #'eql))
185
186;;; Non-simple vectors
187
188(deftest count-filled-vector.1
189  (count 'a (make-array 8 :initial-contents '(a b c d e a e f)
190                        :fill-pointer t))
191  2)
192
193(deftest count-filled-vector.2
194  (count 'a (make-array 8 :initial-contents '(a b c d e a e f)
195                        :fill-pointer t)
196         :test #'eql)
197  2)
198
199(deftest count-filled-vector.3
200  (count 'a (make-array 8 :initial-contents '(a b c d e a e f)
201                        :fill-pointer t)
202         :test 'eql)
203  2)
204
205(deftest count-filled-vector.4
206  (count 1 (make-array 10 :initial-contents '(1 2 2 3 2 1 2 2 5 4)
207                       :fill-pointer t)
208         :key #'1-)
209  5)
210
211(deftest count-filled-vector.5
212  (count 1 (make-array 10 :initial-contents '(1 2 2 3 2 1 2 2 5 4)
213                       :fill-pointer t)
214         :key '1-)
215  5)
216
217(deftest count-filled-vector.6
218  (count 1 (make-array 10 :initial-contents '(1 2 2 3 2 1 2 2 5 4)
219                       :fill-pointer t)
220         :key #'1- :test #'equal)
221  5)
222
223(deftest count-filled-vector.7
224  (count 1 (make-array 12 :initial-contents '(2 1 1 2 3 1 4 1 7 6 1 8)
225                       :fill-pointer t)
226         :from-end t)
227  5)
228
229(deftest count-filled-vector.8
230  (let ((c 0))
231    (count 1 (make-array 10 :initial-contents '(1 2 3 1 4 1 7 6 1 8)
232                         :fill-pointer t)
233           :key #'(lambda (x)
234                    ;; (format t "~%~A ~A" x c)
235                    (prog1 (- x c) (incf c)))))
236  4)
237
238(deftest count-filled-vector.9
239  (let ((c 0))
240    (count 1 (make-array 10 :initial-contents '(1 2 3 7 4 5 7 6 2 8)
241                         :fill-pointer t)
242           :from-end t
243           :key #'(lambda (x)
244                    ;; (format t "~%~A ~A" x c)
245                    (prog1 (- x c) (incf c)))))
246  3)
247
248(deftest count-filled-vector.10
249  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1)
250                       :fill-pointer t)
251         :start 3)
252  4)
253
254(deftest count-filled-vector.11
255  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1)
256                       :fill-pointer t)
257         :end 6)
258  5)
259
260(deftest count-filled-vector.12
261  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1)
262                       :fill-pointer t)
263         :start 2 :end 7)
264  4)
265
266(deftest count-filled-vector.13
267  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1)
268                       :fill-pointer t)
269         :start 3 :end nil)
270  4)
271
272(deftest count-filled-vector.14
273  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1)
274                       :fill-pointer t)
275         :end nil)
276  7)
277
278(deftest count-filled-vector.15
279  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 2 1 1)
280                       :fill-pointer t)
281         :test-not #'eql)
282  1)
283
284(deftest count-filled-vector.16
285  (count 1 (make-array 8 :initial-contents '(1 1 1 3 1 2 1 1)
286                       :fill-pointer t)
287         :start 2 :end 7
288         :test #'(lambda (x y) (declare (ignore x y)) t))
289  5)
290
291(deftest count-filled-vector.17
292  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1)
293                       :fill-pointer 6))
294  6)
295
296(deftest count-filled-vector.18
297  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1)
298                       :fill-pointer 6)
299         :start 2)
300  4)
301(deftest count-filled-vector.19
302  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1)
303                       :fill-pointer 6)
304         :from-end 'foo)
305  6)
306
307(deftest count-filled-vector.20
308  (count 1 (make-array 8 :initial-contents '(1 1 1 1 1 1 1 1)
309                       :fill-pointer 6)
310         :start 2 :from-end 'yes)
311  4)
312
313;;; Other specialized vectors
314
315(deftest count.special-vector.1
316  (do-special-integer-vectors
317   (v #(0 1 1 0 1 1 1 0 1 1 1 1 0) nil)
318   (assert (eql (count 0 v) 4))
319   (assert (eql (count 1 v) 9))
320   (assert (eql (count 2 v) 0))
321   (assert (eql (count 0 v :start 2) 3))
322   (assert (eql (count 1 v :end 11) 8)))
323  nil)
324
325(deftest count.special-vector.2
326  (do-special-integer-vectors
327   (v #(1 2 3 4 5 6 7) nil)
328   (assert (eql (count 0 v) 0))
329   (assert (eql (count 1 v) 1))
330   (assert (eql (count 2 v) 1))
331   (assert (eql (count 3 v) 1))
332   (assert (eql (count 4 v) 1))
333   (assert (eql (count 5 v) 1))
334   (assert (eql (count 6 v) 1))
335   (assert (eql (count 7 v) 1)))
336  nil)
337
338(deftest count.special-vector.3
339  (loop for etype in '(short-float single-float double-float long-float)
340        for vals = (loop for e in '(0 1 2 1 3 1 4 5 6 0)
341                         collect (coerce e etype))
342        for vec = (make-array (length vals) :element-type etype :initial-contents vals)
343        for result = (count (coerce 1 etype) vec)
344        unless (= result 3)
345        collect (list etype vals vec result))
346  nil)
347
348(deftest count.special-vector.4
349  (loop for cetype in '(short-float single-float double-float long-float rational integer)
350        for etype = `(complex ,cetype)
351        for vals = (loop for e in '(4 1 2 1 3 1 4 5 6 6)
352                         collect (complex 0 (coerce e cetype)))
353        for vec = (make-array (length vals) :element-type etype :initial-contents vals)
354        for result = (count (complex 0 (coerce 1 cetype)) vec)
355        unless (= result 3)
356        collect (list etype vals vec result))
357  nil)
358
359
360
361;;; Tests on bit vectors
362
363(deftest count-bit-vector.1
364  (count 1 #*00101100011011000)
365  7)
366
367(deftest count-bit-vector.2
368  (count 1 #*00101100011011000 :test #'eql)
369  7)
370
371(deftest count-bit-vector.3
372  (count 1 #*00101100011011000 :test 'eql)
373  7)
374
375(deftest count-bit-vector.4
376  (count 1 #*00101100011011000 :key #'1+)
377  10)
378
379(deftest count-bit-vector.5
380  (count 0 #*00101100011011000 :key '1-)
381  7)
382
383(deftest count-bit-vector.6
384  (count 0 #*00101100011011000 :key #'1- :test #'equal)
385  7)
386
387(deftest count-bit-vector.7
388  (count 1 #*00101100011011000 :from-end t)
389  7)
390
391(deftest count-bit-vector.8
392  (let ((c 1))
393    (count 0 #*0000110101001
394           :key #'(lambda (x) (setf c (- c)) (+ c x))))
395  2)
396
397(deftest count-bit-vector.9
398  (let ((c 1))
399    (count 0 #*0000011010101
400           :from-end t
401           :key #'(lambda (x) (setf c (- c)) (+ c x))))
402  4)
403
404(deftest count-bit-vector.10
405  (count 1 #*11000110110 :start 3)
406  4)
407
408(deftest count-bit-vector.11
409  (count 1 '#*110111110111 :end 6)
410  5)
411
412(deftest count-bit-vector.12
413  (count 1 #*11111011 :start 2 :end 7)
414  4)
415
416(deftest count-bit-vector.13
417  (count 1 #*11111011 :start 3 :end nil)
418  4)
419
420(deftest count-bit-vector.14
421  (count 1 #*11111011 :end nil)
422  7)
423
424(deftest count-bit-vector.15
425  (count 1 #*11111011  :test-not #'eql)
426  1)
427
428(deftest count-bit-vector.16
429  (count 1 #*11101101 :start 2 :end 7
430         :test #'(lambda (x y) (declare (ignore x y)) t))
431  5)
432
433(deftest count-bit-vector.17
434  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
435                       :element-type 'bit
436                       :fill-pointer 5))
437  4)
438
439(deftest count-bit-vector.18
440  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
441                       :element-type 'bit
442                       :fill-pointer 5)
443         :start 1)
444  3)
445
446(deftest count-bit-vector.19
447  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
448                       :element-type 'bit
449                       :fill-pointer 5)
450         :end nil)
451  4)
452
453
454(deftest count-bit-vector.20
455  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
456                       :element-type 'bit
457                       :fill-pointer 6)
458         :end 4)
459  3)
460
461(deftest count-bit-vector.21
462  (count 1 #*00001100100 :test #'<=)
463  3)
464
465(deftest count-bit-vector.22
466  (count 1 #*00001100100 :test-not #'>)
467  3)
468
469(defharmless count-bit-vector.test-and-test-not.1
470  (count 0 #*0011010101100010000 :test #'eql :test-not #'eql))
471
472(defharmless count-bit-vector.test-and-test-not.2
473  (count 0 #*0011010101100010000 :test-not #'eql :test #'eql))
474
475;;; Tests on strings
476
477(deftest count-string.1
478  (count #\1 "00101100011011000")
479  7)
480
481(deftest count-string.2
482  (count #\1 "00101100011011000" :test #'eql)
483  7)
484
485(deftest count-string.3
486  (count #\1 "00101100011011000" :test 'eql)
487  7)
488
489(deftest count-string.4
490  (count #\1 "00101100011011000" :key #'(lambda (x) (if (eql x #\0) #\1 #\2)))
491  10)
492
493(deftest count-string.5
494  (count #\1 "00101100011011000" :key 'identity)
495  7)
496
497(deftest count-string.6
498  (count #\1 "00101100011011000" :key #'identity :test #'equal)
499  7)
500
501(deftest count-string.7
502  (count #\1 "00101100011011000" :from-end t)
503  7)
504
505(deftest count-string.8
506  (let ((c nil))
507    (count #\0 "0000110101001"
508           :key #'(lambda (x) (setf c (not c))
509                    (and c x))))
510  5)
511
512(deftest count-string.9
513  (let ((c nil))
514    (count #\0 "0000011010101"
515           :from-end t
516           :key #'(lambda (x) (setf c (not c))
517                    (and c x))))
518  3)
519
520(deftest count-string.10
521  (count #\1 "11000110110" :start 3)
522  4)
523
524(deftest count-string.11
525  (count #\1 '"110111110111" :end 6)
526  5)
527
528(deftest count-string.12
529  (count #\1 "11111011" :start 2 :end 7)
530  4)
531
532(deftest count-string.13
533  (count #\1 "11111011" :start 3 :end nil)
534  4)
535
536(deftest count-string.14
537  (count #\1 "11111011" :end nil)
538  7)
539
540(deftest count-string.15
541  (count #\1 "11111011"  :test-not #'eql)
542  1)
543
544(deftest count-string.16
545  (count #\1 "11101101" :start 2 :end 7
546         :test #'(lambda (x y) (declare (ignore x y)) t))
547  5)
548
549(deftest count-string.17
550  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
551                         :fill-pointer 7
552                         :element-type 'character))
553  5)
554
555(deftest count-string.18
556  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
557                         :fill-pointer 7
558                         :element-type 'character)
559         :start 1)
560  4)
561
562(deftest count-string.19
563  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
564                         :fill-pointer 7
565                         :element-type 'character)
566         :end nil)
567  5)
568
569(deftest count-string.20
570  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
571                         :fill-pointer 7
572                         :element-type 'character)
573         :start 2 :end 5)
574  3)
575
576(deftest count-string.21
577  (count #\1 "00001100100" :test #'char<=)
578  3)
579
580(deftest count-string.22
581  (count #\1 "00001100100" :test-not #'char>)
582  3)
583
584(deftest count-string.23
585  (do-special-strings
586   (s "a1a3abcda" nil)
587   (assert (= (count #\a s) 4)))
588  nil)
589
590(defharmless count-string.test-and-test-not.1
591  (count #\0 "0011010101100010000" :test #'eql :test-not #'eql))
592
593(defharmless count-string.test-and-test-not.2
594  (count #\0 "0011010101100010000" :test-not #'eql :test #'eql))
595
596;;; Argument order tests
597
598(deftest count.order.1
599  (let ((i 0) c1 c2 c3 c4 c5 c6 c7)
600    (values
601     (count (progn (setf c1 (incf i)) nil)
602            (progn (setf c2 (incf i)) '(a nil b c nil d e))
603            :start (progn (setf c3 (incf i)) 0)
604            :end (progn (setf c4 (incf i)) 3)
605            :key (progn (setf c5 (incf i)) #'identity)
606            :from-end (progn (setf c6 (incf i)) nil)
607            :test (progn (setf c7 (incf i)) #'eql)
608            )
609     i c1 c2 c3 c4 c5 c6 c7))
610  1 7 1 2 3 4 5 6 7)
611
612(deftest count.order.2
613  (let ((i 0) c1 c2 c3 c4 c5 c6 c7)
614    (values
615     (count (progn (setf c1 (incf i)) nil)
616            (progn (setf c2 (incf i)) '(a nil b c nil d e))
617            :test (progn (setf c3 (incf i)) #'eql)
618            :from-end (progn (setf c4 (incf i)) nil)
619            :key (progn (setf c5 (incf i)) #'identity)
620            :end (progn (setf c6 (incf i)) 3)
621            :start (progn (setf c7 (incf i)) 0)
622            )
623     i c1 c2 c3 c4 c5 c6 c7))
624  1 7 1 2 3 4 5 6 7)
625
626
627;;; Keyword tests
628
629(deftest count.allow-other-keys.1
630  (count 'a '(b a d a c) :bad t :allow-other-keys t)
631  2)
632
633(deftest count.allow-other-keys.2
634  (count 'a '(b a d a c) :allow-other-keys #p"*" :also-bad t)
635  2)
636
637;;; The leftmost of two :allow-other-keys arguments is the one that  matters.
638(deftest count.allow-other-keys.3
639  (count 'a '(b a d a c)
640         :allow-other-keys t
641         :allow-other-keys nil
642         :bad t)
643  2)
644
645(deftest count.keywords.4
646  (count 2 '(1 2 3 2 5) :key #'identity :key #'1+)
647  2)
648
649(deftest count.allow-other-keys.5
650  (count 'a '(a b c a) :allow-other-keys nil)
651  2)
652
653;;; Error tests
654
655(deftest count.error.1
656  (check-type-error #'(lambda (x) (count 'a x)) #'sequencep)
657  nil)
658
659(deftest count.error.4
660  (signals-error (count) program-error)
661  t)
662
663(deftest count.error.5
664  (signals-error (count nil) program-error)
665  t)
666
667(deftest count.error.6
668  (signals-error (count nil nil :bad t) program-error)
669  t)
670
671(deftest count.error.7
672  (signals-error (count nil nil :bad t :allow-other-keys nil)
673                 program-error)
674  t)
675
676(deftest count.error.8
677  (signals-error (count nil nil :key) program-error)
678  t)
679
680(deftest count.error.9
681  (signals-error (count nil nil 3 3) program-error)
682  t)
683
684;;; Only leftmost :allow-other-keys argument matters
685(deftest count.error.10
686  (signals-error (count 'a nil :bad t
687                         :allow-other-keys nil
688                         :allow-other-keys t)
689                 program-error)
690  t)
691
692(deftest count.error.11
693  (signals-error (locally (count 'a 1) t) type-error)
694  t)
695
696(deftest count.error.12
697  (signals-error (count 'b '(a b c) :test #'identity)
698                 program-error)
699  t)
700
701(deftest count.error.13
702  (signals-error (count 'b '(a b c) :key #'car) type-error)
703  t)
704
705(deftest count.error.14
706  (signals-error (count 'b '(a b c) :test-not #'identity)
707                 program-error)
708  t)
709
710(deftest count.error.15
711  (signals-error (count 'b '(a b c) :key #'cons)
712                 program-error)
713  t)
Note: See TracBrowser for help on using the repository browser.