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