source: trunk/source/tests/ansi-tests/position-if.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: 13.1 KB
Line 
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(deftest position-if-vector.14
219  (let* ((v1 #(x x x a b 1 d a b 2 d y y y y y))
220         (v2 (make-array '(8) :displaced-to v1
221                        :displaced-index-offset 3)))
222    (values (position-if #'integerp v2)
223            (position-if #'integerp v2 :from-end t)))
224  2 6)
225
226;;; Bit vector tests
227
228(deftest position-if-bit-vector.1
229  (position-if #'evenp #*111010101)
230  3)
231
232(deftest position-if-bit-vector.2
233  (position-if 'evenp #*111010101)
234  3)
235
236(deftest position-if-bit-vector.3
237  (position-if #'evenp #*111010101 :start 4)
238  5)
239
240(deftest position-if-bit-vector.4
241  (position-if #'evenp #*111010101 :from-end t)
242  7)
243
244(deftest position-if-bit-vector.5
245  (position-if #'evenp #*111010101 :from-end nil)
246  3)
247
248(deftest position-if-bit-vector.6
249  (position-if #'evenp #*111010101 :start 4
250               :from-end t)
251  7)
252
253(deftest position-if-bit-vector.7
254  (position-if #'evenp #*111010101 :end nil)
255  3)
256
257(deftest position-if-bit-vector.8
258  (position-if #'evenp #*111010101 :end 3)
259  nil)
260
261(deftest position-if-bit-vector.9
262  (loop for i from 0 to 8
263        collect
264        (loop for j from (1+ i) to 9
265              collect
266              (position-if #'evenp #*111010101 :start i :end j)))
267  ((nil nil nil 3 3 3 3 3 3)
268   (nil nil 3 3 3 3 3 3)
269   (nil 3 3 3 3 3 3)
270   (3 3 3 3 3 3)
271   (nil 5 5 5 5)
272   (5 5 5 5)
273   (nil 7 7)
274   (7 7)
275   (nil)))
276
277(deftest position-if-bit-vector.10
278  (loop for i from 0 to 8
279        collect
280        (loop for j from (1+ i) to 9
281              collect
282              (position-if #'evenp #*111010101 :start i :end j
283                           :from-end t)))
284  ((nil nil nil 3 3 5 5 7 7)
285   (nil nil 3 3 5 5 7 7)
286   (nil 3 3 5 5 7 7)
287   (3 3 5 5 7 7)
288   (nil 5 5 7 7)
289   (5 5 7 7)
290   (nil 7 7)
291   (7 7)
292   (nil)))
293
294(deftest position-if-bit-vector.11
295  (loop for i from 0 to 8
296        collect
297        (loop for j from (1+ i) to 9
298              collect
299              (position-if #'oddp #*111010101 :start i :end j
300                           :key #'1+)))
301  ((nil nil nil 3 3 3 3 3 3)
302   (nil nil 3 3 3 3 3 3)
303   (nil 3 3 3 3 3 3)
304   (3 3 3 3 3 3)
305   (nil 5 5 5 5)
306   (5 5 5 5)
307   (nil 7 7)
308   (7 7)
309   (nil)))
310
311(deftest position-if-bit-vector.12
312  (loop for i from 0 to 8
313        collect
314        (loop for j from (1+ i) to 9
315              collect
316              (position-if #'oddp #*111010101 :start i :end j
317                           :key '1+ :from-end t)))
318  ((nil nil nil 3 3 5 5 7 7)
319   (nil nil 3 3 5 5 7 7)
320   (nil 3 3 5 5 7 7)
321   (3 3 5 5 7 7)
322   (nil 5 5 7 7)
323   (5 5 7 7)
324   (nil 7 7)
325   (7 7)
326   (nil)))
327
328(deftest position-if-bit-vector.13
329  (let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
330                       :fill-pointer 5
331                       :element-type 'bit)))
332    (values (position-if #'evenp a)
333            (position-if #'evenp a :from-end 'foo)
334            (position-if #'oddp a)
335            (position-if #'oddp a :from-end 'foo)))
336  nil nil 0 4)
337
338;;; string tests
339
340(deftest position-if-string.1
341  (position-if #'evendigitp "131432189")
342  3)
343
344(deftest position-if-string.2
345  (position-if 'evendigitp "131432189")
346  3)
347
348(deftest position-if-string.3
349  (position-if #'evendigitp "131432189" :start 4)
350  5)
351
352(deftest position-if-string.4
353  (position-if #'evendigitp "131432189" :from-end t)
354  7)
355
356(deftest position-if-string.5
357  (position-if #'evendigitp "131432189" :from-end nil)
358  3)
359
360(deftest position-if-string.6
361  (position-if #'evendigitp "131432189" :start 4
362               :from-end t)
363  7)
364
365(deftest position-if-string.7
366  (position-if #'evendigitp "131432189" :end nil)
367  3)
368
369(deftest position-if-string.8
370  (position-if #'evendigitp "131432189" :end 3)
371  nil)
372
373(deftest position-if-string.9
374  (loop for i from 0 to 8
375        collect
376        (loop for j from (1+ i) to 9
377              collect
378              (position-if #'evendigitp "131432189" :start i :end j)))
379  ((nil nil nil 3 3 3 3 3 3)
380   (nil nil 3 3 3 3 3 3)
381   (nil 3 3 3 3 3 3)
382   (3 3 3 3 3 3)
383   (nil 5 5 5 5)
384   (5 5 5 5)
385   (nil 7 7)
386   (7 7)
387   (nil)))
388
389(deftest position-if-string.10
390  (loop for i from 0 to 8
391        collect
392        (loop for j from (1+ i) to 9
393              collect
394              (position-if #'evendigitp "131432189" :start i :end j
395                           :from-end t)))
396  ((nil nil nil 3 3 5 5 7 7)
397   (nil nil 3 3 5 5 7 7)
398   (nil 3 3 5 5 7 7)
399   (3 3 5 5 7 7)
400   (nil 5 5 7 7)
401   (5 5 7 7)
402   (nil 7 7)
403   (7 7)
404   (nil)))
405
406(deftest position-if-string.11
407  (loop for i from 0 to 8
408        collect
409        (loop for j from (1+ i) to 9
410              collect
411              (position-if #'odddigitp "131432189" :start i :end j
412                           :key #'nextdigit)))
413  ((nil nil nil 3 3 3 3 3 3)
414   (nil nil 3 3 3 3 3 3)
415   (nil 3 3 3 3 3 3)
416   (3 3 3 3 3 3)
417   (nil 5 5 5 5)
418   (5 5 5 5)
419   (nil 7 7)
420   (7 7)
421   (nil)))
422
423(deftest position-if-string.12
424  (loop for i from 0 to 8
425        collect
426        (loop for j from (1+ i) to 9
427              collect
428              (position-if #'odddigitp "131432189" :start i :end j
429                           :key 'nextdigit :from-end t)))
430  ((nil nil nil 3 3 5 5 7 7)
431   (nil nil 3 3 5 5 7 7)
432   (nil 3 3 5 5 7 7)
433   (3 3 5 5 7 7)
434   (nil 5 5 7 7)
435   (5 5 7 7)
436   (nil 7 7)
437   (7 7)
438   (nil)))
439
440(deftest position-if-string.13
441  (flet ((%f (c) (eql c #\0))
442         (%g (c) (eql c #\1)))
443    (let ((a (make-array '(10) :initial-contents "1111100000"
444                       :fill-pointer 5
445                       :element-type 'character)))
446    (values (position-if #'%f a)
447            (position-if #'%f a :from-end 'foo)
448            (position-if #'%g a)
449            (position-if #'%g a :from-end 'foo))))
450  nil nil 0 4)
451
452(deftest position-if-string.14
453  (do-special-strings
454   (s "12345a6  78b90" nil)
455   (let ((pos (position-if #'alpha-char-p s)))
456     (assert (eql pos 5) () "First alpha char in ~A is at position ~A" s pos)))
457  nil)
458
459(deftest position-if-string.15
460  (do-special-strings
461   (s "12345a6  78b90" nil)
462   (let ((pos (position-if #'alpha-char-p s :from-end t)))
463     (assert (eql pos 11) () "Last alpha char in ~A is at position ~A" s pos)))
464  nil)
465
466
467(deftest position-if.order.1
468  (let ((i 0) a b c d e f)
469    (values
470     (position-if
471      (progn (setf a (incf i)) #'zerop)
472      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
473      :from-end (setf c (incf i))
474      :start (progn (setf d (incf i)) 1)
475      :end (progn (setf e (incf i)) 6)
476      :key (progn (setf f (incf i)) #'1-))
477     i a b c d e f))
478  4 6 1 2 3 4 5 6)
479
480(deftest position-if.order.2
481  (let ((i 0) a b c d e f)
482    (values
483     (position-if
484      (progn (setf a (incf i)) #'zerop)
485      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
486      :key (progn (setf c (incf i)) #'1-)
487      :end (progn (setf d (incf i)) 6)
488      :start (progn (setf e (incf i)) 1)
489      :from-end (setf f (incf i)))
490     i a b c d e f))
491  4 6 1 2 3 4 5 6)
492
493;;; Keyword tests
494
495(deftest position-if.allow-other-keys.1
496  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t)
497  2)
498
499(deftest position-if.allow-other-keys.2
500  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys nil)
501  2)
502
503(deftest position-if.allow-other-keys.3
504  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t :bad t)
505  2)
506
507(deftest position-if.allow-other-keys.4
508  (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t)
509  2)
510
511(deftest position-if.allow-other-keys.5
512  (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t :key #'1-)
513  0)
514
515(deftest position-if.keywords.6
516  (position-if #'zerop '(1 2 0 3 2 1) :key #'1- :key #'identity)
517  0)
518
519(deftest position-if.allow-other-keys.7
520  (position-if #'zerop '(1 2 0 3 2 1) :bad t :allow-other-keys t
521               :allow-other-keys nil)
522  2)
523
524(deftest position-if.allow-other-keys.8
525  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t :bad t
526               :allow-other-keys nil)
527  2)
528
529(deftest position-if.allow-other-keys.9
530  (position-if #'zerop '(1 2 0 3 2 1) :allow-other-keys t
531               :allow-other-keys nil :bad t)
532  2)
533
534
535;;; Error tests
536
537(deftest position-if.error.1
538  (check-type-error #'(lambda (x) (position-if #'identity x)) #'sequencep)
539  nil)
540
541(deftest position-if.error.4
542  (signals-error (position-if 'null '(a b c . d)) type-error)
543  t)
544
545(deftest position-if.error.5
546  (signals-error (position-if) program-error)
547  t)
548
549(deftest position-if.error.6
550  (signals-error (position-if #'null) program-error)
551  t)
552
553(deftest position-if.error.7
554  (signals-error (position-if #'null nil :key) program-error)
555  t)
556
557(deftest position-if.error.8
558  (signals-error (position-if #'null nil 'bad t) program-error)
559  t)
560
561(deftest position-if.error.9
562  (signals-error (position-if #'null nil 'bad t :allow-other-keys nil) program-error)
563  t)
564
565(deftest position-if.error.10
566  (signals-error (position-if #'null nil 1 2) program-error)
567  t)
568
569(deftest position-if.error.11
570  (signals-error (locally (position-if #'identity 'b) t) type-error)
571  t)
572
573(deftest position-if.error.12
574  (signals-error (position-if #'cons '(a b c d)) program-error)
575  t)
576
577(deftest position-if.error.13
578  (signals-error (position-if #'car '(a b c d)) type-error)
579  t)
580
581(deftest position-if.error.14
582  (signals-error (position-if #'identity '(a b c d) :key #'cdr) type-error)
583  t)
584
585(deftest position-if.error.15
586  (signals-error (position-if #'identity '(a b c d) :key #'cons) program-error)
587  t)
Note: See TracBrowser for help on using the repository browser.