← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/count-if-not.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-if-not.lsp
 
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
;;; tests on bit-vectors
 
275
 
 
276
(deftest count-if-not-bit-vector.1
 
277
  (count-if-not #'oddp #*001011101101)
 
278
  5)
 
279
 
 
280
(deftest count-if-not-bit-vector.2
 
281
  (count-if-not #'identity #*001011101101)
 
282
  0)
 
283
 
 
284
(deftest count-if-not-bit-vector.3
 
285
  (count-if-not #'(lambda (x) (break)) #*)
 
286
  0)
 
287
 
 
288
(deftest count-if-not-bit-vector.4
 
289
  (count-if-not #'identity #*001011101101 :key #'zerop)
 
290
  7)
 
291
 
 
292
(deftest count-if-not-bit-vector.5
 
293
  (count-if-not 'not #*001011101101 :key #'zerop)
 
294
  5)
 
295
 
 
296
(deftest count-if-not-bit-vector.6
 
297
  (count-if-not #'not #*001011101101 :key 'zerop)
 
298
  5)
 
299
 
 
300
(deftest count-if-not-bit-vector.8
 
301
  (count-if-not #'identity #*001011101101 :key 'oddp)
 
302
  5)
 
303
 
 
304
(deftest count-if-not-bit-vector.10
 
305
  (count-if-not #'oddp #*001011101101 :key #'1+)
 
306
  7)
 
307
 
 
308
(deftest count-if-not-bit-vector.11
 
309
  (let ((c 0))
 
310
    (count-if-not #'oddp #*001011101101
 
311
                  :key #'(lambda (x) (+ x (incf c)))))
 
312
  7)
 
313
 
 
314
(deftest count-if-not-bit-vector.12
 
315
  (let ((c 0))
 
316
    (count-if-not #'oddp #*001011101101
 
317
              :from-end t
 
318
              :key #'(lambda (x) (+ x (incf c)))))
 
319
  5)
 
320
 
 
321
(deftest count-if-not-bit-vector.13
 
322
  (count-if-not #'zerop #*0111011011100 :start 2)
 
323
  7)
 
324
 
 
325
(deftest count-if-not-bit-vector.14
 
326
  (count-if-not #'zerop #*0111011011100 :end 7)
 
327
  5)
 
328
  
 
329
(deftest count-if-not-bit-vector.15
 
330
  (count-if-not #'zerop #*0111011011100 :end 7 :start 2)
 
331
  4)
 
332
  
 
333
(deftest count-if-not-bit-vector.16
 
334
  (count-if-not #'zerop #*0111011011100 :end 7 :start 2 :from-end t)
 
335
  4)
 
336
 
 
337
(deftest count-if-not-bit-vector.17
 
338
  (let ((a (make-array '(10) :initial-contents '(0 0 0 1 1 1 0 1 0 0)
 
339
                       :fill-pointer 5
 
340
                       :element-type 'bit)))
 
341
    (and (bit-vector-p a)
 
342
         (values (count-if-not #'zerop a)
 
343
                 (count-if-not #'oddp a)
 
344
                 (count-if-not #'zerop a :from-end t)
 
345
                 (count-if-not #'oddp a :from-end t))))
 
346
  2 3 2 3)
 
347
 
 
348
;;; tests on strings
 
349
 
 
350
(deftest count-if-not-string.1
 
351
  (count-if-not #'(lambda (x) (eql x #\0)) "001011101101")
 
352
  7)
 
353
 
 
354
(deftest count-if-not-string.2
 
355
  (count-if-not #'identity "001011101101")
 
356
  0)
 
357
 
 
358
(deftest count-if-not-string.3
 
359
  (count-if-not #'(lambda (x) (break)) "")
 
360
  0)
 
361
 
 
362
(deftest count-if-not-string.4
 
363
  (count-if-not #'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
 
364
  7)
 
365
 
 
366
(deftest count-if-not-string.5
 
367
  (count-if-not 'identity "001011101101" :key #'(lambda (x) (eql x #\0)))
 
368
  7)
 
369
 
 
370
(deftest count-if-not-string.6
 
371
  (count-if-not #'(lambda (x) (eql x #\0)) "001011101101" :key 'identity)
 
372
  7)
 
373
 
 
374
(deftest count-if-not-string.8
 
375
  (count-if-not #'identity "001011101101" :key #'(lambda (x) (eql x #\1)))
 
376
  5)
 
377
 
 
378
(deftest count-if-not-string.11
 
379
  (let ((c 0))
 
380
    (count-if-not #'oddp "001011101101"
 
381
                  :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
 
382
  7)
 
383
 
 
384
(deftest count-if-not-string.12
 
385
  (let ((c 0))
 
386
    (count-if-not #'oddp "001011101101"
 
387
                  :from-end t
 
388
                  :key #'(lambda (x) (+ (if (eql x #\0) 0 1) (incf c)))))
 
389
  5)
 
390
 
 
391
(deftest count-if-not-string.13
 
392
  (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :start 2)
 
393
  7)
 
394
 
 
395
(deftest count-if-not-string.14
 
396
  (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :end 7)
 
397
  5)
 
398
  
 
399
(deftest count-if-not-string.15
 
400
  (count-if-not #'(lambda (x) (eql x #\0)) "0111011011100" :end 7 :start 2)
 
401
  4)
 
402
  
 
403
(deftest count-if-not-string.16
 
404
  (count-if-not #'(lambda (x) (eql x #\0))
 
405
                "0111011011100" :end 7 :start 2 :from-end t)
 
406
  4)
 
407
 
 
408
(deftest count-if-not-string.17
 
409
  (flet ((%zerop (c) (eql c #\0))
 
410
         (%onep (c) (eql c #\1)))
 
411
    (let ((a (make-array '(10) :initial-contents "0001110100"
 
412
                         :fill-pointer 5
 
413
                         :element-type 'character)))
 
414
      (and (stringp a)
 
415
           (values (count-if-not #'%zerop a)
 
416
                   (count-if-not #'%onep a)
 
417
                   (count-if-not #'%zerop a :from-end t)
 
418
                   (count-if-not #'%onep a :from-end t)))))
 
419
  2 3 2 3)
 
420
 
 
421
;;; Argument order tests
 
422
 
 
423
(deftest count-if-not.order.1
 
424
  (let ((i 0) c1 c2 c3 c4 c5 c6)
 
425
    (values
 
426
     (count-if-not
 
427
      (progn (setf c1 (incf i)) #'null)
 
428
      (progn (setf c2 (incf i)) '(a nil b c nil d e))
 
429
      :start (progn (setf c3 (incf i)) 0)
 
430
      :end (progn (setf c4 (incf i)) 3)
 
431
      :key (progn (setf c5 (incf i)) #'not)
 
432
      :from-end (progn (setf c6 (incf i)) nil)
 
433
      )
 
434
     i c1 c2 c3 c4 c5 c6))
 
435
  1 6 1 2 3 4 5 6)
 
436
 
 
437
(deftest count-if-not.order.2
 
438
  (let ((i 0) c1 c2 c3 c4 c5 c6)
 
439
    (values
 
440
     (count-if-not
 
441
      (progn (setf c1 (incf i)) #'null)
 
442
      (progn (setf c2 (incf i)) '(a nil b c nil d e))
 
443
      :from-end (progn (setf c3 (incf i)) nil)
 
444
      :key (progn (setf c4 (incf i)) #'not)
 
445
      :end (progn (setf c5 (incf i)) 3)
 
446
      :start (progn (setf c6 (incf i)) 0)
 
447
      )
 
448
     i c1 c2 c3 c4 c5 c6))
 
449
  1 6 1 2 3 4 5 6)
 
450
 
 
451
;;; Keyword tests
 
452
 
 
453
(deftest count-if-not.keywords.1
 
454
  (count-if-not #'oddp '(1 2 3 4 5) :bad t :allow-other-keys t)
 
455
  2)
 
456
 
 
457
(deftest count-if-not.keywords.2
 
458
  (count-if-not #'oddp '(1 2 3 4 5) :allow-other-keys #p"*" :also-bad t)
 
459
  2)
 
460
 
 
461
;;; The leftmost of two :allow-other-keys arguments is the one that  matters.
 
462
(deftest count-if-not.keywords.3
 
463
  (count-if-not #'oddp '(1 2 3 4 5)
 
464
            :allow-other-keys t
 
465
            :allow-other-keys nil
 
466
            :bad t)
 
467
  2)
 
468
 
 
469
(deftest count-if-not.keywords.4
 
470
  (count-if-not #'oddp '(1 2 3 4 5) :key #'identity :key #'1+)
 
471
  2)
 
472
 
 
473
(deftest count-if-not.allow-other-keys.5
 
474
  (count-if-not #'null '(nil a b c nil) :allow-other-keys nil)
 
475
  3)
 
476
 
 
477
;;; Error tests
 
478
 
 
479
(deftest count-if-not.error.1
 
480
  (signals-error (count-if-not #'identity 1) type-error)
 
481
  t)
 
482
 
 
483
(deftest count-if-not.error.2
 
484
  (signals-error (count-if-not #'identity 'a) type-error)
 
485
  t)
 
486
 
 
487
(deftest count-if-not.error.3
 
488
  (signals-error (count-if-not #'identity #\a) type-error)
 
489
  t)
 
490
 
 
491
(deftest count-if-not.error.4
 
492
  (signals-error (count-if-not) program-error)
 
493
  t)
 
494
 
 
495
(deftest count-if-not.error.5
 
496
  (signals-error (count-if-not #'null) program-error)
 
497
  t)
 
498
 
 
499
(deftest count-if-not.error.6
 
500
  (signals-error (count-if-not #'null nil :bad t) program-error)
 
501
  t)
 
502
 
 
503
(deftest count-if-not.error.7
 
504
  (signals-error (count-if-not #'null nil :bad t :allow-other-keys nil)
 
505
                 program-error)
 
506
  t)
 
507
 
 
508
(deftest count-if-not.error.8
 
509
  (signals-error (count-if-not #'null nil :key) program-error)
 
510
  t)
 
511
 
 
512
(deftest count-if-not.error.9
 
513
  (signals-error (count-if-not #'null nil 3 3) program-error)
 
514
  t)
 
515
 
 
516
;;; Only leftmost :allow-other-keys argument matters
 
517
(deftest count-if-not.error.10
 
518
  (signals-error (count-if-not #'null nil :bad t
 
519
                                :allow-other-keys nil
 
520
                                :allow-other-keys t)
 
521
                 program-error)
 
522
  t)
 
523
 
 
524
(deftest count-if-not.error.11
 
525
  (signals-error (locally (count-if-not #'identity 1) t)
 
526
                 type-error)
 
527
  t)
 
528
 
 
529
(deftest count-if-not.error.12
 
530
  (signals-error (count-if-not #'cons '(a b c)) program-error)
 
531
  t)
 
532
 
 
533
(deftest count-if-not.error.13
 
534
  (signals-error (count-if-not #'car '(a b c)) type-error)
 
535
  t)
 
536
 
 
537
(deftest count-if-not.error.14
 
538
  (signals-error (count-if-not #'identity '(a b c) :key #'cdr)
 
539
                 type-error)
 
540
  t)
 
541
 
 
542
(deftest count-if-not.error.15
 
543
  (signals-error (count-if-not #'identity '(a b c) :key #'cons)
 
544
                 program-error)
 
545
  t)