← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/count.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/count.lsp
 
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
 
 
314
 
 
315
;;; Tests on bit vectors
 
316
 
 
317
(deftest count-bit-vector.1
 
318
  (count 1 #*00101100011011000)
 
319
  7)
 
320
 
 
321
(deftest count-bit-vector.2
 
322
  (count 1 #*00101100011011000 :test #'eql)
 
323
  7)
 
324
 
 
325
(deftest count-bit-vector.3
 
326
  (count 1 #*00101100011011000 :test 'eql)
 
327
  7)
 
328
 
 
329
(deftest count-bit-vector.4
 
330
  (count 1 #*00101100011011000 :key #'1+)
 
331
  10)
 
332
 
 
333
(deftest count-bit-vector.5
 
334
  (count 0 #*00101100011011000 :key '1-)
 
335
  7)
 
336
 
 
337
(deftest count-bit-vector.6
 
338
  (count 0 #*00101100011011000 :key #'1- :test #'equal)
 
339
  7)
 
340
 
 
341
(deftest count-bit-vector.7
 
342
  (count 1 #*00101100011011000 :from-end t)
 
343
  7)
 
344
 
 
345
(deftest count-bit-vector.8
 
346
  (let ((c 1))
 
347
    (count 0 #*0000110101001
 
348
           :key #'(lambda (x) (setf c (- c)) (+ c x))))
 
349
  2)
 
350
 
 
351
(deftest count-bit-vector.9
 
352
  (let ((c 1))
 
353
    (count 0 #*0000011010101
 
354
           :from-end t
 
355
           :key #'(lambda (x) (setf c (- c)) (+ c x))))
 
356
  4)
 
357
 
 
358
(deftest count-bit-vector.10
 
359
  (count 1 #*11000110110 :start 3)
 
360
  4)
 
361
 
 
362
(deftest count-bit-vector.11
 
363
  (count 1 '#*110111110111 :end 6)
 
364
  5)
 
365
 
 
366
(deftest count-bit-vector.12
 
367
  (count 1 #*11111011 :start 2 :end 7)
 
368
  4)
 
369
 
 
370
(deftest count-bit-vector.13
 
371
  (count 1 #*11111011 :start 3 :end nil)
 
372
  4)
 
373
 
 
374
(deftest count-bit-vector.14
 
375
  (count 1 #*11111011 :end nil)
 
376
  7)
 
377
 
 
378
(deftest count-bit-vector.15
 
379
  (count 1 #*11111011  :test-not #'eql)
 
380
  1)
 
381
 
 
382
(deftest count-bit-vector.16
 
383
  (count 1 #*11101101 :start 2 :end 7
 
384
         :test #'(lambda (x y) (declare (ignore x y)) t))
 
385
  5)
 
386
 
 
387
(deftest count-bit-vector.17
 
388
  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
 
389
                       :element-type 'bit
 
390
                       :fill-pointer 5))
 
391
  4)
 
392
 
 
393
(deftest count-bit-vector.18
 
394
  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
 
395
                       :element-type 'bit
 
396
                       :fill-pointer 5)
 
397
         :start 1)
 
398
  3)
 
399
 
 
400
(deftest count-bit-vector.19
 
401
  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
 
402
                       :element-type 'bit
 
403
                       :fill-pointer 5)
 
404
         :end nil)
 
405
  4)
 
406
 
 
407
 
 
408
(deftest count-bit-vector.20
 
409
  (count 1 (make-array 8 :initial-contents '(1 0 1 1 1 1 1 1)
 
410
                       :element-type 'bit
 
411
                       :fill-pointer 6)
 
412
         :end 4)
 
413
  3)
 
414
 
 
415
(deftest count-bit-vector.21
 
416
  (count 1 #*00001100100 :test #'<=)
 
417
  3)
 
418
 
 
419
(deftest count-bit-vector.22
 
420
  (count 1 #*00001100100 :test-not #'>)
 
421
  3)
 
422
 
 
423
(defharmless count-bit-vector.test-and-test-not.1
 
424
  (count 0 #*0011010101100010000 :test #'eql :test-not #'eql))
 
425
 
 
426
(defharmless count-bit-vector.test-and-test-not.2
 
427
  (count 0 #*0011010101100010000 :test-not #'eql :test #'eql))
 
428
 
 
429
;;; Tests on strings
 
430
 
 
431
(deftest count-string.1
 
432
  (count #\1 "00101100011011000")
 
433
  7)
 
434
 
 
435
(deftest count-string.2
 
436
  (count #\1 "00101100011011000" :test #'eql)
 
437
  7)
 
438
 
 
439
(deftest count-string.3
 
440
  (count #\1 "00101100011011000" :test 'eql)
 
441
  7)
 
442
 
 
443
(deftest count-string.4
 
444
  (count #\1 "00101100011011000" :key #'(lambda (x) (if (eql x #\0) #\1 #\2)))
 
445
  10)
 
446
 
 
447
(deftest count-string.5
 
448
  (count #\1 "00101100011011000" :key 'identity)
 
449
  7)
 
450
 
 
451
(deftest count-string.6
 
452
  (count #\1 "00101100011011000" :key #'identity :test #'equal)
 
453
  7)
 
454
 
 
455
(deftest count-string.7
 
456
  (count #\1 "00101100011011000" :from-end t)
 
457
  7)
 
458
 
 
459
(deftest count-string.8
 
460
  (let ((c nil))
 
461
    (count #\0 "0000110101001"
 
462
           :key #'(lambda (x) (setf c (not c))
 
463
                    (and c x))))
 
464
  5)
 
465
 
 
466
(deftest count-string.9
 
467
  (let ((c nil))
 
468
    (count #\0 "0000011010101"
 
469
           :from-end t
 
470
           :key #'(lambda (x) (setf c (not c))
 
471
                    (and c x))))
 
472
  3)
 
473
 
 
474
(deftest count-string.10
 
475
  (count #\1 "11000110110" :start 3)
 
476
  4)
 
477
 
 
478
(deftest count-string.11
 
479
  (count #\1 '"110111110111" :end 6)
 
480
  5)
 
481
 
 
482
(deftest count-string.12
 
483
  (count #\1 "11111011" :start 2 :end 7)
 
484
  4)
 
485
 
 
486
(deftest count-string.13
 
487
  (count #\1 "11111011" :start 3 :end nil)
 
488
  4)
 
489
 
 
490
(deftest count-string.14
 
491
  (count #\1 "11111011" :end nil)
 
492
  7)
 
493
 
 
494
(deftest count-string.15
 
495
  (count #\1 "11111011"  :test-not #'eql)
 
496
  1)
 
497
 
 
498
(deftest count-string.16
 
499
  (count #\1 "11101101" :start 2 :end 7
 
500
         :test #'(lambda (x y) (declare (ignore x y)) t))
 
501
  5)
 
502
 
 
503
(deftest count-string.17
 
504
  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
 
505
                         :fill-pointer 7
 
506
                         :element-type 'character))
 
507
  5)
 
508
 
 
509
(deftest count-string.18
 
510
  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
 
511
                         :fill-pointer 7
 
512
                         :element-type 'character)
 
513
         :start 1)
 
514
  4)
 
515
 
 
516
(deftest count-string.19
 
517
  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
 
518
                         :fill-pointer 7
 
519
                         :element-type 'character)
 
520
         :end nil)
 
521
  5)
 
522
 
 
523
(deftest count-string.20
 
524
  (count #\a (make-array 10 :initial-contents "abaaacaaaa"
 
525
                         :fill-pointer 7
 
526
                         :element-type 'character)
 
527
         :start 2 :end 5)
 
528
  3)
 
529
 
 
530
(deftest count-string.21
 
531
  (count #\1 "00001100100" :test #'char<=)
 
532
  3)
 
533
 
 
534
(deftest count-string.22
 
535
  (count #\1 "00001100100" :test-not #'char>)
 
536
  3)
 
537
 
 
538
(defharmless count-string.test-and-test-not.1
 
539
  (count #\0 "0011010101100010000" :test #'eql :test-not #'eql))
 
540
 
 
541
(defharmless count-string.test-and-test-not.2
 
542
  (count #\0 "0011010101100010000" :test-not #'eql :test #'eql))
 
543
 
 
544
;;; Argument order tests
 
545
 
 
546
(deftest count.order.1
 
547
  (let ((i 0) c1 c2 c3 c4 c5 c6 c7)
 
548
    (values
 
549
     (count (progn (setf c1 (incf i)) nil)
 
550
            (progn (setf c2 (incf i)) '(a nil b c nil d e))
 
551
            :start (progn (setf c3 (incf i)) 0)
 
552
            :end (progn (setf c4 (incf i)) 3)
 
553
            :key (progn (setf c5 (incf i)) #'identity)
 
554
            :from-end (progn (setf c6 (incf i)) nil)
 
555
            :test (progn (setf c7 (incf i)) #'eql)
 
556
            )
 
557
     i c1 c2 c3 c4 c5 c6 c7))
 
558
  1 7 1 2 3 4 5 6 7)
 
559
 
 
560
(deftest count.order.2
 
561
  (let ((i 0) c1 c2 c3 c4 c5 c6 c7)
 
562
    (values
 
563
     (count (progn (setf c1 (incf i)) nil)
 
564
            (progn (setf c2 (incf i)) '(a nil b c nil d e))
 
565
            :test (progn (setf c3 (incf i)) #'eql)
 
566
            :from-end (progn (setf c4 (incf i)) nil)
 
567
            :key (progn (setf c5 (incf i)) #'identity)
 
568
            :end (progn (setf c6 (incf i)) 3)
 
569
            :start (progn (setf c7 (incf i)) 0)
 
570
            )
 
571
     i c1 c2 c3 c4 c5 c6 c7))
 
572
  1 7 1 2 3 4 5 6 7)
 
573
 
 
574
 
 
575
;;; Keyword tests
 
576
 
 
577
(deftest count.allow-other-keys.1
 
578
  (count 'a '(b a d a c) :bad t :allow-other-keys t)
 
579
  2)
 
580
 
 
581
(deftest count.allow-other-keys.2
 
582
  (count 'a '(b a d a c) :allow-other-keys #p"*" :also-bad t)
 
583
  2)
 
584
 
 
585
;;; The leftmost of two :allow-other-keys arguments is the one that  matters.
 
586
(deftest count.allow-other-keys.3
 
587
  (count 'a '(b a d a c)
 
588
         :allow-other-keys t
 
589
         :allow-other-keys nil
 
590
         :bad t)
 
591
  2)
 
592
 
 
593
(deftest count.keywords.4
 
594
  (count 2 '(1 2 3 2 5) :key #'identity :key #'1+)
 
595
  2)
 
596
 
 
597
(deftest count.allow-other-keys.5
 
598
  (count 'a '(a b c a) :allow-other-keys nil)
 
599
  2)
 
600
 
 
601
;;; Error tests
 
602
 
 
603
(deftest count.error.1
 
604
  (signals-error (count 'a 1) type-error)
 
605
  t)
 
606
 
 
607
(deftest count.error.2
 
608
  (signals-error (count 'a 'a) type-error)
 
609
  t)
 
610
 
 
611
(deftest count.error.3
 
612
  (signals-error (count 'a #\a) type-error)
 
613
  t)
 
614
 
 
615
(deftest count.error.4
 
616
  (signals-error (count) program-error)
 
617
  t)
 
618
 
 
619
(deftest count.error.5
 
620
  (signals-error (count nil) program-error)
 
621
  t)
 
622
 
 
623
(deftest count.error.6
 
624
  (signals-error (count nil nil :bad t) program-error)
 
625
  t)
 
626
 
 
627
(deftest count.error.7
 
628
  (signals-error (count nil nil :bad t :allow-other-keys nil)
 
629
                 program-error)
 
630
  t)
 
631
 
 
632
(deftest count.error.8
 
633
  (signals-error (count nil nil :key) program-error)
 
634
  t)
 
635
 
 
636
(deftest count.error.9
 
637
  (signals-error (count nil nil 3 3) program-error)
 
638
  t)
 
639
 
 
640
;;; Only leftmost :allow-other-keys argument matters
 
641
(deftest count.error.10
 
642
  (signals-error (count 'a nil :bad t
 
643
                         :allow-other-keys nil
 
644
                         :allow-other-keys t)
 
645
                 program-error)
 
646
  t)
 
647
 
 
648
(deftest count.error.11
 
649
  (signals-error (locally (count 'a 1) t) type-error)
 
650
  t)
 
651
 
 
652
(deftest count.error.12
 
653
  (signals-error (count 'b '(a b c) :test #'identity)
 
654
                 program-error)
 
655
  t)
 
656
 
 
657
(deftest count.error.13
 
658
  (signals-error (count 'b '(a b c) :key #'car) type-error)
 
659
  t)
 
660
 
 
661
(deftest count.error.14
 
662
  (signals-error (count 'b '(a b c) :test-not #'identity)
 
663
                 program-error)
 
664
  t)
 
665
 
 
666
(deftest count.error.15
 
667
  (signals-error (count 'b '(a b c) :key #'cons)
 
668
                 program-error)
 
669
  t)