← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/position-if.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/position-if.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Fri Aug 23 22:08:57 2002
 
4
;;;; Contains: Tests for POSITION-IF
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest position-if-list.1
 
9
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9))
 
10
  3)
 
11
 
 
12
(deftest position-if-list.2
 
13
  (position-if 'evenp '(1 3 1 4 3 2 1 8 9))
 
14
  3)
 
15
 
 
16
(deftest position-if-list.3
 
17
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start 4)
 
18
  5)
 
19
 
 
20
(deftest position-if-list.4
 
21
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :from-end t)
 
22
  7)
 
23
 
 
24
(deftest position-if-list.5
 
25
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :from-end nil)
 
26
  3)
 
27
 
 
28
(deftest position-if-list.6
 
29
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start 4
 
30
               :from-end t)
 
31
  7)
 
32
 
 
33
(deftest position-if-list.7
 
34
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :end nil)
 
35
  3)
 
36
 
 
37
(deftest position-if-list.8
 
38
  (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :end 3)
 
39
  nil)
 
40
 
 
41
(deftest position-if-list.9
 
42
  (loop for i from 0 to 8
 
43
        collect
 
44
        (loop for j from (1+ i) to 9
 
45
              collect
 
46
              (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j)))
 
47
  ((nil nil nil 3 3 3 3 3 3)
 
48
   (nil nil 3 3 3 3 3 3)
 
49
   (nil 3 3 3 3 3 3)
 
50
   (3 3 3 3 3 3)
 
51
   (nil 5 5 5 5)
 
52
   (5 5 5 5)
 
53
   (nil 7 7)
 
54
   (7 7)
 
55
   (nil)))
 
56
 
 
57
(deftest position-if-list.10
 
58
  (loop for i from 0 to 8
 
59
        collect
 
60
        (loop for j from (1+ i) to 9
 
61
              collect
 
62
              (position-if #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j
 
63
                           :from-end t)))
 
64
  ((nil nil nil 3 3 5 5 7 7)
 
65
   (nil nil 3 3 5 5 7 7)
 
66
   (nil 3 3 5 5 7 7)
 
67
   (3 3 5 5 7 7)
 
68
   (nil 5 5 7 7)
 
69
   (5 5 7 7)
 
70
   (nil 7 7)
 
71
   (7 7)
 
72
   (nil)))
 
73
 
 
74
(deftest position-if-list.11
 
75
  (loop for i from 0 to 8
 
76
        collect
 
77
        (loop for j from (1+ i) to 9
 
78
              collect
 
79
              (position-if #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j
 
80
                           :key '1+)))
 
81
  ((nil nil nil 3 3 3 3 3 3)
 
82
   (nil nil 3 3 3 3 3 3)
 
83
   (nil 3 3 3 3 3 3)
 
84
   (3 3 3 3 3 3)
 
85
   (nil 5 5 5 5)
 
86
   (5 5 5 5)
 
87
   (nil 7 7)
 
88
   (7 7)
 
89
   (nil)))
 
90
 
 
91
(deftest position-if-list.12
 
92
  (loop for i from 0 to 8
 
93
        collect
 
94
        (loop for j from (1+ i) to 9
 
95
              collect
 
96
              (position-if #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j
 
97
                           :key #'1+ :from-end t)))
 
98
  ((nil nil nil 3 3 5 5 7 7)
 
99
   (nil nil 3 3 5 5 7 7)
 
100
   (nil 3 3 5 5 7 7)
 
101
   (3 3 5 5 7 7)
 
102
   (nil 5 5 7 7)
 
103
   (5 5 7 7)
 
104
   (nil 7 7)
 
105
   (7 7)
 
106
   (nil)))
 
107
 
 
108
;;; Vector tests
 
109
 
 
110
(deftest position-if-vector.1
 
111
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9))
 
112
  3)
 
113
 
 
114
(deftest position-if-vector.2
 
115
  (position-if 'evenp #(1 3 1 4 3 2 1 8 9))
 
116
  3)
 
117
 
 
118
(deftest position-if-vector.3
 
119
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start 4)
 
120
  5)
 
121
 
 
122
(deftest position-if-vector.4
 
123
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :from-end t)
 
124
  7)
 
125
 
 
126
(deftest position-if-vector.5
 
127
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :from-end nil)
 
128
  3)
 
129
 
 
130
(deftest position-if-vector.6
 
131
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start 4
 
132
               :from-end t)
 
133
  7)
 
134
 
 
135
(deftest position-if-vector.7
 
136
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :end nil)
 
137
  3)
 
138
 
 
139
(deftest position-if-vector.8
 
140
  (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :end 3)
 
141
  nil)
 
142
 
 
143
(deftest position-if-vector.9
 
144
  (loop for i from 0 to 8
 
145
        collect
 
146
        (loop for j from (1+ i) to 9
 
147
              collect
 
148
              (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j)))
 
149
  ((nil nil nil 3 3 3 3 3 3)
 
150
   (nil nil 3 3 3 3 3 3)
 
151
   (nil 3 3 3 3 3 3)
 
152
   (3 3 3 3 3 3)
 
153
   (nil 5 5 5 5)
 
154
   (5 5 5 5)
 
155
   (nil 7 7)
 
156
   (7 7)
 
157
   (nil)))
 
158
 
 
159
(deftest position-if-vector.10
 
160
  (loop for i from 0 to 8
 
161
        collect
 
162
        (loop for j from (1+ i) to 9
 
163
              collect
 
164
              (position-if #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j
 
165
                           :from-end t)))
 
166
  ((nil nil nil 3 3 5 5 7 7)
 
167
   (nil nil 3 3 5 5 7 7)
 
168
   (nil 3 3 5 5 7 7)
 
169
   (3 3 5 5 7 7)
 
170
   (nil 5 5 7 7)
 
171
   (5 5 7 7)
 
172
   (nil 7 7)
 
173
   (7 7)
 
174
   (nil)))
 
175
 
 
176
(deftest position-if-vector.11
 
177
  (loop for i from 0 to 8
 
178
        collect
 
179
        (loop for j from (1+ i) to 9
 
180
              collect
 
181
              (position-if #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j
 
182
                           :key '1+)))
 
183
  ((nil nil nil 3 3 3 3 3 3)
 
184
   (nil nil 3 3 3 3 3 3)
 
185
   (nil 3 3 3 3 3 3)
 
186
   (3 3 3 3 3 3)
 
187
   (nil 5 5 5 5)
 
188
   (5 5 5 5)
 
189
   (nil 7 7)
 
190
   (7 7)
 
191
   (nil)))
 
192
 
 
193
(deftest position-if-vector.12
 
194
  (loop for i from 0 to 8
 
195
        collect
 
196
        (loop for j from (1+ i) to 9
 
197
              collect
 
198
              (position-if #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j
 
199
                           :key #'1+ :from-end t)))
 
200
  ((nil nil nil 3 3 5 5 7 7)
 
201
   (nil nil 3 3 5 5 7 7)
 
202
   (nil 3 3 5 5 7 7)
 
203
   (3 3 5 5 7 7)
 
204
   (nil 5 5 7 7)
 
205
   (5 5 7 7)
 
206
   (nil 7 7)
 
207
   (7 7)
 
208
   (nil)))
 
209
 
 
210
(deftest position-if-vector.13
 
211
  (let ((a (make-array '(10) :initial-contents '(1 3 1 4 3 1 2 1 8 9)
 
212
                       :fill-pointer 5)))
 
213
    (flet ((%f (x) (eql x 1)))
 
214
      (values (position-if #'%f a)
 
215
              (position-if #'%f a :from-end t))))
 
216
  0 2)        
 
217
 
 
218
;;; Bit vector tests
 
219
 
 
220
(deftest position-if-bit-vector.1
 
221
  (position-if #'evenp #*111010101)
 
222
  3)
 
223
 
 
224
(deftest position-if-bit-vector.2
 
225
  (position-if 'evenp #*111010101)
 
226
  3)
 
227
 
 
228
(deftest position-if-bit-vector.3
 
229
  (position-if #'evenp #*111010101 :start 4)
 
230
  5)
 
231
 
 
232
(deftest position-if-bit-vector.4
 
233
  (position-if #'evenp #*111010101 :from-end t)
 
234
  7)
 
235
 
 
236
(deftest position-if-bit-vector.5
 
237
  (position-if #'evenp #*111010101 :from-end nil)
 
238
  3)
 
239
 
 
240
(deftest position-if-bit-vector.6
 
241
  (position-if #'evenp #*111010101 :start 4
 
242
               :from-end t)
 
243
  7)
 
244
 
 
245
(deftest position-if-bit-vector.7
 
246
  (position-if #'evenp #*111010101 :end nil)
 
247
  3)
 
248
 
 
249
(deftest position-if-bit-vector.8
 
250
  (position-if #'evenp #*111010101 :end 3)
 
251
  nil)
 
252
 
 
253
(deftest position-if-bit-vector.9
 
254
  (loop for i from 0 to 8
 
255
        collect
 
256
        (loop for j from (1+ i) to 9
 
257
              collect
 
258
              (position-if #'evenp #*111010101 :start i :end j)))
 
259
  ((nil nil nil 3 3 3 3 3 3)
 
260
   (nil nil 3 3 3 3 3 3)
 
261
   (nil 3 3 3 3 3 3)
 
262
   (3 3 3 3 3 3)
 
263
   (nil 5 5 5 5)
 
264
   (5 5 5 5)
 
265
   (nil 7 7)
 
266
   (7 7)
 
267
   (nil)))
 
268
 
 
269
(deftest position-if-bit-vector.10
 
270
  (loop for i from 0 to 8
 
271
        collect
 
272
        (loop for j from (1+ i) to 9
 
273
              collect
 
274
              (position-if #'evenp #*111010101 :start i :end j
 
275
                           :from-end t)))
 
276
  ((nil nil nil 3 3 5 5 7 7)
 
277
   (nil nil 3 3 5 5 7 7)
 
278
   (nil 3 3 5 5 7 7)
 
279
   (3 3 5 5 7 7)
 
280
   (nil 5 5 7 7)
 
281
   (5 5 7 7)
 
282
   (nil 7 7)
 
283
   (7 7)
 
284
   (nil)))
 
285
 
 
286
(deftest position-if-bit-vector.11
 
287
  (loop for i from 0 to 8
 
288
        collect
 
289
        (loop for j from (1+ i) to 9
 
290
              collect
 
291
              (position-if #'oddp #*111010101 :start i :end j
 
292
                           :key #'1+)))
 
293
  ((nil nil nil 3 3 3 3 3 3)
 
294
   (nil nil 3 3 3 3 3 3)
 
295
   (nil 3 3 3 3 3 3)
 
296
   (3 3 3 3 3 3)
 
297
   (nil 5 5 5 5)
 
298
   (5 5 5 5)
 
299
   (nil 7 7)
 
300
   (7 7)
 
301
   (nil)))
 
302
 
 
303
(deftest position-if-bit-vector.12
 
304
  (loop for i from 0 to 8
 
305
        collect
 
306
        (loop for j from (1+ i) to 9
 
307
              collect
 
308
              (position-if #'oddp #*111010101 :start i :end j
 
309
                           :key '1+ :from-end t)))
 
310
  ((nil nil nil 3 3 5 5 7 7)
 
311
   (nil nil 3 3 5 5 7 7)
 
312
   (nil 3 3 5 5 7 7)
 
313
   (3 3 5 5 7 7)
 
314
   (nil 5 5 7 7)
 
315
   (5 5 7 7)
 
316
   (nil 7 7)
 
317
   (7 7)
 
318
   (nil)))
 
319
 
 
320
(deftest position-if-bit-vector.13
 
321
  (let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
 
322
                       :fill-pointer 5
 
323
                       :element-type 'bit)))
 
324
    (values (position-if #'evenp a)
 
325
            (position-if #'evenp a :from-end 'foo)
 
326
            (position-if #'oddp a)
 
327
            (position-if #'oddp a :from-end 'foo)))
 
328
  nil nil 0 4)
 
329
 
 
330
;;; string tests
 
331
 
 
332
(deftest position-if-string.1
 
333
  (position-if #'evendigitp "131432189")
 
334
  3)
 
335
 
 
336
(deftest position-if-string.2
 
337
  (position-if 'evendigitp "131432189")
 
338
  3)
 
339
 
 
340
(deftest position-if-string.3
 
341
  (position-if #'evendigitp "131432189" :start 4)
 
342
  5)
 
343
 
 
344
(deftest position-if-string.4
 
345
  (position-if #'evendigitp "131432189" :from-end t)
 
346
  7)
 
347
 
 
348
(deftest position-if-string.5
 
349
  (position-if #'evendigitp "131432189" :from-end nil)
 
350
  3)
 
351
 
 
352
(deftest position-if-string.6
 
353
  (position-if #'evendigitp "131432189" :start 4
 
354
               :from-end t)
 
355
  7)
 
356
 
 
357
(deftest position-if-string.7
 
358
  (position-if #'evendigitp "131432189" :end nil)
 
359
  3)
 
360
 
 
361
(deftest position-if-string.8
 
362
  (position-if #'evendigitp "131432189" :end 3)
 
363
  nil)
 
364
 
 
365
(deftest position-if-string.9
 
366
  (loop for i from 0 to 8
 
367
        collect
 
368
        (loop for j from (1+ i) to 9
 
369
              collect
 
370
              (position-if #'evendigitp "131432189" :start i :end j)))
 
371
  ((nil nil nil 3 3 3 3 3 3)
 
372
   (nil nil 3 3 3 3 3 3)
 
373
   (nil 3 3 3 3 3 3)
 
374
   (3 3 3 3 3 3)
 
375
   (nil 5 5 5 5)
 
376
   (5 5 5 5)
 
377
   (nil 7 7)
 
378
   (7 7)
 
379
   (nil)))
 
380
 
 
381
(deftest position-if-string.10
 
382
  (loop for i from 0 to 8
 
383
        collect
 
384
        (loop for j from (1+ i) to 9
 
385
              collect
 
386
              (position-if #'evendigitp "131432189" :start i :end j
 
387
                           :from-end t)))
 
388
  ((nil nil nil 3 3 5 5 7 7)
 
389
   (nil nil 3 3 5 5 7 7)
 
390
   (nil 3 3 5 5 7 7)
 
391
   (3 3 5 5 7 7)
 
392
   (nil 5 5 7 7)
 
393
   (5 5 7 7)
 
394
   (nil 7 7)
 
395
   (7 7)
 
396
   (nil)))
 
397
 
 
398
(deftest position-if-string.11
 
399
  (loop for i from 0 to 8
 
400
        collect
 
401
        (loop for j from (1+ i) to 9
 
402
              collect
 
403
              (position-if #'odddigitp "131432189" :start i :end j
 
404
                           :key #'nextdigit)))
 
405
  ((nil nil nil 3 3 3 3 3 3)
 
406
   (nil nil 3 3 3 3 3 3)
 
407
   (nil 3 3 3 3 3 3)
 
408
   (3 3 3 3 3 3)
 
409
   (nil 5 5 5 5)
 
410
   (5 5 5 5)
 
411
   (nil 7 7)
 
412
   (7 7)
 
413
   (nil)))
 
414
 
 
415
(deftest position-if-string.12
 
416
  (loop for i from 0 to 8
 
417
        collect
 
418
        (loop for j from (1+ i) to 9
 
419
              collect
 
420
              (position-if #'odddigitp "131432189" :start i :end j
 
421
                           :key 'nextdigit :from-end t)))
 
422
  ((nil nil nil 3 3 5 5 7 7)
 
423
   (nil nil 3 3 5 5 7 7)
 
424
   (nil 3 3 5 5 7 7)
 
425
   (3 3 5 5 7 7)
 
426
   (nil 5 5 7 7)
 
427
   (5 5 7 7)
 
428
   (nil 7 7)
 
429
   (7 7)
 
430
   (nil)))
 
431
 
 
432
(deftest position-if-string.13
 
433
  (flet ((%f (c) (eql c #\0))
 
434
         (%g (c) (eql c #\1)))
 
435
    (let ((a (make-array '(10) :initial-contents "1111100000"
 
436
                       :fill-pointer 5
 
437
                       :element-type 'character)))
 
438
    (values (position-if #'%f a)
 
439
            (position-if #'%f a :from-end 'foo)
 
440
            (position-if #'%g a)
 
441
            (position-if #'%g a :from-end 'foo))))
 
442
  nil nil 0 4)
 
443
 
 
444
(deftest position-if.order.1
 
445
  (let ((i 0) a b c d e f)
 
446
    (values
 
447
     (position-if
 
448
      (progn (setf a (incf i)) #'zerop)
 
449
      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
 
450
      :from-end (setf c (incf i))
 
451
      :start (progn (setf d (incf i)) 1)
 
452
      :end (progn (setf e (incf i)) 6)
 
453
      :key (progn (setf f (incf i)) #'1-))
 
454
     i a b c d e f))
 
455
  4 6 1 2 3 4 5 6)
 
456
 
 
457
(deftest position-if.order.2
 
458
  (let ((i 0) a b c d e f)
 
459
    (values
 
460
     (position-if
 
461
      (progn (setf a (incf i)) #'zerop)
 
462
      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
 
463
      :key (progn (setf c (incf i)) #'1-)
 
464
      :end (progn (setf d (incf i)) 6)
 
465
      :start (progn (setf e (incf i)) 1)
 
466
      :from-end (setf f (incf i)))
 
467
     i a b c d e f))
 
468
  4 6 1 2 3 4 5 6)
 
469
 
 
470
;;; Keyword tests
 
471
 
 
472
(deftest position-if.allow-other-keys.1
 
473
  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t)
 
474
  2)
 
475
 
 
476
(deftest position-if.allow-other-keys.2
 
477
  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys nil)
 
478
  2)
 
479
 
 
480
(deftest position-if.allow-other-keys.3
 
481
  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t :bad t)
 
482
  2)
 
483
 
 
484
(deftest position-if.allow-other-keys.4
 
485
  (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t)
 
486
  2)
 
487
 
 
488
(deftest position-if.allow-other-keys.5
 
489
  (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t :key #'1-)
 
490
  0)
 
491
 
 
492
(deftest position-if.keywords.6
 
493
  (position-if #'zerop '(1 2 0 3 2 1) :key #'1- :key #'identity)
 
494
  0)
 
495
 
 
496
(deftest position-if.allow-other-keys.7
 
497
  (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t
 
498
               :allow-other-keys nil)
 
499
  2)
 
500
 
 
501
(deftest position-if.allow-other-keys.8
 
502
  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t :bad t
 
503
               :allow-other-keys nil)
 
504
  2)
 
505
 
 
506
(deftest position-if.allow-other-keys.9
 
507
  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t
 
508
               :allow-other-keys nil :bad t)
 
509
  2)
 
510
 
 
511
 
 
512
;;; Error tests
 
513
 
 
514
(deftest position-if.error.1
 
515
  (signals-error (position-if #'identity 'b) type-error)
 
516
  t)
 
517
 
 
518
(deftest position-if.error.2
 
519
  (signals-error (position-if #'identity 10) type-error)
 
520
  t)
 
521
 
 
522
(deftest position-if.error.3
 
523
  (signals-error (position-if 'null 1.4) type-error)
 
524
  t)
 
525
 
 
526
(deftest position-if.error.4
 
527
  (signals-error (position-if 'null '(a b c . d)) type-error)
 
528
  t)
 
529
 
 
530
(deftest position-if.error.5
 
531
  (signals-error (position-if) program-error)
 
532
  t)
 
533
 
 
534
(deftest position-if.error.6
 
535
  (signals-error (position-if #'null) program-error)
 
536
  t)
 
537
 
 
538
(deftest position-if.error.7
 
539
  (signals-error (position-if #'null nil :key) program-error)
 
540
  t)
 
541
 
 
542
(deftest position-if.error.8
 
543
  (signals-error (position-if #'null nil 'bad t) program-error)
 
544
  t)
 
545
 
 
546
(deftest position-if.error.9
 
547
  (signals-error (position-if #'null nil 'bad t :allow-other-keys nil) program-error)
 
548
  t)
 
549
 
 
550
(deftest position-if.error.10
 
551
  (signals-error (position-if #'null nil 1 2) program-error)
 
552
  t)
 
553
 
 
554
(deftest position-if.error.11
 
555
  (signals-error (locally (position-if #'identity 'b) t) type-error)
 
556
  t)
 
557
 
 
558
(deftest position-if.error.12
 
559
  (signals-error (position-if #'cons '(a b c d)) program-error)
 
560
  t)
 
561
 
 
562
(deftest position-if.error.13
 
563
  (signals-error (position-if #'car '(a b c d)) type-error)
 
564
  t)
 
565
 
 
566
(deftest position-if.error.14
 
567
  (signals-error (position-if #'identity '(a b c d) :key #'cdr) type-error)
 
568
  t)
 
569
 
 
570
(deftest position-if.error.15
 
571
  (signals-error (position-if #'identity '(a b c d) :key #'cons) program-error)
 
572
  t)