source: trunk/source/tests/ansi-tests/position-if-not.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

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