source: trunk/source/tests/ansi-tests/map-into.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: 12.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug 18 10:10:04 2002
4;;;; Contains: Tests for the MAP-INTO function
5
6(in-package :cl-test)
7
8(deftest map-into-list.1
9  (let ((a (copy-seq '(a b c d e f)))
10        (b nil))
11    (map-into a #'(lambda (x) (push x b) x)  '(1 2 3 4 5 6))
12    (values a b))
13  (1 2 3 4 5 6)
14  (6 5 4 3 2 1))
15
16(deftest map-into-list.2
17  (let ((a (copy-seq '(a b c d e f g))))
18    (map-into a #'identity '(1 2 3))
19    a)
20  (1 2 3 d e f g))
21
22(deftest map-into-list.3
23  (let ((a (copy-seq '(a b c))))
24    (map-into a #'identity '(1 2 3 4 5 6))
25    a)
26  (1 2 3))
27
28(deftest map-into-list.4
29  (let ((a (copy-seq '(a b c d e f)))
30        (b nil))
31    (map-into a #'(lambda (x y) (let ((z (+ x y))) (push z b) z))
32              '(1 2 3 4 5 6)
33              '(10 11 12 13 14 15))
34    (values a b))
35  (11 13 15 17 19 21)
36  (21 19 17 15 13 11))
37
38(deftest map-into-list.5
39  (let ((a (copy-seq '(a b c d e f))))
40    (map-into a 'identity '(1 2 3 4 5 6))
41    a)
42  (1 2 3 4 5 6))
43
44(deftest map-into-list.6
45  (let ((b nil))
46    (values
47     (map-into nil #'(lambda (x y) (let ((z (+ x y))) (push z b) z))
48               '(1 2 3 4 5 6)
49               '(10 11 12 13 14 15))
50     b))
51  nil nil)
52
53(deftest map-into-list.7
54  (let ((a (copy-seq '(a b c d e f))))
55    (map-into a #'(lambda () 1))
56    a)
57  (1 1 1 1 1 1))
58
59(deftest map-into-list.8
60  (let ((a (copy-seq '(a b c d e f)))
61        (s2 (make-array '(6) :initial-element 'x
62                        :fill-pointer 4)))
63    (map-into a #'identity s2)
64    a)
65  (x x x x e f))
66
67(deftest map-into-array.1
68  (let ((a (copy-seq #(a b c d e f)))
69        b)
70    (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6))
71    (values a b))
72  #(1 2 3 4 5 6)
73  (6 5 4 3 2 1))
74
75(deftest map-into-array.2
76  (let ((a (copy-seq #(a b c d e f g h)))
77        b)
78    (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6))
79    (values a b))
80  #(1 2 3 4 5 6 g h)
81  (6 5 4 3 2 1))
82
83(deftest map-into-array.3
84  (let ((a (copy-seq #(a b c d)))
85        b)
86    (map-into a #'(lambda (x) (push x b) x) '(1 2 3 4 5 6))
87    (values a b))
88  #(1 2 3 4)
89  (4 3 2 1))
90
91(deftest map-into-array.4
92  (let ((a (copy-seq #(a b c d e f)))
93        b)
94    (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6))
95    (values a b))
96  #(1 2 3 4 5 6)
97  (6 5 4 3 2 1))
98
99(deftest map-into-array.5
100  (let ((a (copy-seq #(a b c d e f g h)))
101        b)
102    (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6))
103    (values a b))
104  #(1 2 3 4 5 6 g h)
105  (6 5 4 3 2 1))
106
107(deftest map-into-array.6
108  (let ((a (copy-seq #(a b c d)))
109        b)
110    (map-into a #'(lambda (x) (push x b) x) #(1 2 3 4 5 6))
111    (values a b))
112  #(1 2 3 4)
113  (4 3 2 1))
114
115;;; Tests of mapping into arrays with fill pointers
116(deftest map-into-array.7
117  (let ((a (make-array 6 :initial-element 'x
118                       :fill-pointer 3)))
119    (map-into a #'identity '(1 2 3))
120    a)
121  #(1 2 3))
122
123(deftest map-into-array.8
124  (let ((a (make-array 6 :initial-element 'x
125                       :fill-pointer 3)))
126    (map-into a #'identity '(1 2))
127    a)
128  #(1 2))
129
130(deftest map-into-array.9
131  (let ((a (make-array 6 :initial-element 'x
132                       :fill-pointer 3)))
133    (map-into a #'identity '(1 2 3 4 5))
134    (and (eqlt (fill-pointer a) 5)
135         a))
136  #(1 2 3 4 5))
137
138(deftest map-into-array.10
139  (let ((a (make-array 6 :initial-element 'x
140                       :fill-pointer 3)))
141    (map-into a #'(lambda () 'y))
142    (and (eqlt (fill-pointer a) 6)
143         a))
144  #(y y y y y y))
145
146(deftest map-into-array.11
147  (let ((a (copy-seq #(a b c d e f)))
148        (s2 (make-array '(6) :initial-element 'x
149                        :fill-pointer 4)))
150    (map-into a #'identity s2)
151    a)
152  #(x x x x e f))
153
154;;; mapping into strings
155
156(deftest map-into-string.1
157  (let ((a (copy-seq "abcdef")))
158    (map-into a #'identity "123456")
159    (values (not (not (stringp a))) a))
160  t
161  "123456")
162
163(deftest map-into-string.2
164  (let ((a (copy-seq "abcdef")))
165    (map-into a #'identity "1234")
166    (values (not (not (stringp a))) a))
167  t
168  "1234ef")
169
170(deftest map-into-string.3
171  (let ((a (copy-seq "abcd")))
172    (map-into a #'identity "123456")
173    (values (not (not (stringp a))) a))
174  t
175  "1234")
176
177(deftest map-into-string.4
178  (let ((a (make-array 6 :initial-element #\x
179                       :element-type 'character
180                       :fill-pointer 3)))
181    (map-into a #'identity "abcde")
182    (values
183     (fill-pointer a)
184     (aref a 5)
185     a))
186  5
187  #\x
188  "abcde")
189
190(deftest map-into-string.5
191  (let ((a (make-array 6 :initial-element #\x
192                       :element-type 'character
193                       :fill-pointer 3)))
194    (map-into a #'(lambda () #\y))
195    (values (fill-pointer a)
196            a))
197  6
198  "yyyyyy")
199
200(deftest map-into-string.6
201  (let ((a (make-array 6 :initial-element #\x
202                       :element-type 'character)))
203    (map-into a #'(lambda () #\y))
204    a)
205  "yyyyyy")
206
207(deftest map-into-string.7
208  (let ((a (make-array 6 :initial-element #\x
209                       :element-type 'base-char
210                       :fill-pointer 3)))
211    (map-into a #'identity "abcde")
212    (values (fill-pointer a)
213            (aref a 5)
214            a))
215  5
216  #\x
217  "abcde")
218
219(deftest map-into-string.8
220  (let ((a (make-array 6 :initial-element #\x
221                       :element-type 'base-char
222                       :fill-pointer 3)))
223    (map-into a #'(lambda () #\y))
224    (values (fill-pointer a)
225            a))
226  6
227  "yyyyyy")
228
229(deftest map-into-string.9
230  (let ((a (make-array 6 :initial-element #\x
231                       :element-type 'base-char)))
232    (map-into a #'(lambda () #\y))
233    a)
234  "yyyyyy")
235
236(deftest map-into-string.10
237  (let ((a (copy-seq "abcdef"))
238        (s2 (make-array '(6) :initial-element #\x
239                        :fill-pointer 4)))
240    (map-into a #'identity s2)
241    a)
242  "xxxxef")
243
244(deftest map-into-string.11
245  (let ((a (make-array 6 :initial-element #\x
246                       :element-type 'character
247                       :fill-pointer 3)))
248    (map-into a #'identity "abcd")
249    (values
250     (fill-pointer a)
251     (aref a 4)
252     (aref a 5)
253     a))
254  4
255  #\x
256  #\x
257  "abcd")
258
259(deftest map-into-string.12
260  (let ((a (make-array 6 :initial-element #\x
261                       :element-type 'character
262                       :fill-pointer 3)))
263    (map-into a #'identity "abcdefgh")
264    (values
265     (fill-pointer a)
266     a))
267  6
268  "abcdef")
269
270(deftest map-into-string.13
271  (do-special-strings
272   (s (copy-seq "12345") nil)
273   (let ((s2 (map-into s #'identity "abcde")))
274     (assert (eq s s2))
275     (assert (string= s2 "abcde"))))
276  nil)
277
278(deftest map-into-string.14
279  (do-special-strings
280   (s "abcde" nil)
281   (let* ((s1 (copy-seq "123456"))
282          (s2 (map-into s1 #'identity s)))
283     (assert (eq s1 s2))
284     (assert (string= s2 "abcde6"))))
285  nil)
286
287;;; Tests on bit vectors
288
289(deftest map-into.bit-vector.1
290  (let ((v (copy-seq #*0100110)))
291    (map-into v #'(lambda (x) (- 1 x)) v)
292    (and (bit-vector-p v)
293         v))
294  #*1011001)
295
296(deftest map-into.bit-vector.2
297  (let ((v (copy-seq #*0100110)))
298    (map-into v #'(lambda () 0))
299    (and (bit-vector-p v)
300         v))
301  #*0000000)
302
303(deftest map-into.bit-vector.3
304  (let ((v (copy-seq #*0100110)))
305    (map-into v #'identity '(0 1 1 1 0 0 1))
306    (and (bit-vector-p v)
307         v))
308  #*0111001)
309
310(deftest map-into.bit-vector.4
311  (let ((v (copy-seq #*0100110)))
312    (map-into v #'identity '(0 1 1 1))
313    (and (bit-vector-p v)
314         v))
315  #*0111110)
316
317(deftest map-into.bit-vector.5
318  (let ((v (copy-seq #*0100110)))
319    (map-into v #'identity '(0 1 1 1 0 0 1 4 5 6 7))
320    (and (bit-vector-p v)
321         v))
322  #*0111001)
323
324(deftest map-into.bit-vector.6
325  (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1)
326                       :fill-pointer 4
327                       :element-type 'bit)))
328    (map-into v #'(lambda () 1))
329    (and (bit-vector-p v)
330         v))
331  #*11111111)
332
333(deftest map-into.bit-vector.7
334  (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1)
335                       :fill-pointer 4
336                       :element-type 'bit)))
337    (map-into v  #'identity v)
338    (and (bit-vector-p v)
339         v))
340  #*0100)
341
342(deftest map-into.bit-vector.8
343  (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1)
344                       :fill-pointer 4
345                       :element-type 'bit)))
346    (map-into v #'identity '(1 1 1 1 1 1))
347    (and (bit-vector-p v)
348         (values (fill-pointer v)
349                 v)))
350  6
351  #*111111)
352
353(deftest map-into.bit-vector.9
354  (let ((v (make-array '(8) :initial-contents '(0 1 0 0 1 1 0 1)
355                       :fill-pointer 4
356                       :element-type 'bit)))
357    (map-into v #'identity '(1 1 1 1 1 1 0 0 1 1 1))
358    (and (bit-vector-p v)
359         (values (fill-pointer v)
360                 v)))
361  8
362  #*11111100)
363
364;;; Other specialized vectors
365
366(deftest map-into.specialized-vector.1
367  (do-special-integer-vectors
368   (v #(1 2 3 4) nil)
369   (let ((result (list nil nil nil nil)))
370     (assert (eq (map-into result #'identity v) result))
371     (assert (equal result '(1 2 3 4)))))
372  nil)
373
374(deftest map-into.specialized-vector.2
375  (do-special-integer-vectors
376   (v #(1 2 3) nil)
377   (let ((result (list nil nil nil nil)))
378     (assert (eq (map-into result #'identity v) result))
379     (assert (equal result '(1 2 3 nil)))))
380  nil)
381
382(deftest map-into.specialized-vector.3
383  (do-special-integer-vectors
384   (v #(1 1 0 1 1) nil)
385   (let ((result (list nil nil nil nil)))
386     (assert (eq (map-into result #'identity v) result))
387     (assert (equal result '(1 1 0 1)))))
388  nil)
389
390(deftest map-into.specialized-vector.4
391  (do-special-integer-vectors
392   (v #(1 2 1 2 2) nil)
393   (let ((v2 #(2 1 2 2 1)))
394     (assert (eq (map-into v #'identity v2) v))
395     (assert (equalp v #(2 1 2 2 1)))))
396  nil)
397
398(deftest map-into.specialized-vector.5
399  (let ((len 10))
400    (loop for etype in '(short-float single-float double-float long-float)
401          for vals = (loop for i below len collect (coerce i etype))
402          for vec = (make-array len :initial-contents vals :element-type etype)
403          for target = (loop repeat len collect nil)
404          for result = (map-into target #'identity vec)
405          unless (and (eq target result)
406                      (= (length result) len)
407                      (= (length vec) len)
408                      (equal vals result))
409          collect (list etype vals vec result)))
410  nil)
411
412(deftest map-into.specialized-vector.6
413  (let ((len 10))
414    (loop for cetype in '(short-float single-float double-float long-float)
415          for etype = `(complex ,cetype)
416          for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
417                                                                (coerce (- i) cetype)))
418          for vec = (make-array len :initial-contents vals :element-type etype)
419          for target = (loop repeat len collect nil)
420          for result = (map-into target #'identity vec)
421          unless (and (eq target result)
422                      (= (length result) len)
423                      (= (length vec) len)
424                      (equal vals result))
425          collect (list etype vals vec result)))
426  nil)
427
428(deftest map-into.specialized-vector.7
429  (let ((len 10))
430    (loop for etype in '(short-float single-float double-float long-float)
431          for vals = (loop for i below len collect (coerce i etype))
432          for target = (make-array len :initial-contents vals :element-type etype)
433          for result = (map-into target #'identity vals)
434          unless (and (eq target result)
435                      (= (length result) len)
436                      (every #'= result vals))
437          collect (list etype vals result)))
438  nil)
439
440(deftest map-into.specialized-vector.8
441  (let ((len 10))
442    (loop for cetype in '(short-float single-float double-float long-float)
443          for etype = `(complex ,cetype)
444          for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
445                                                                (coerce (- i) cetype)))
446          for target = (make-array len :initial-contents vals :element-type etype)
447          for result = (map-into target #'identity vals)
448          unless (and (eq target result)
449                      (= (length result) len)
450                      (every #'= result vals))
451          collect (list etype vals result)))
452  nil)
453
454;;; Error cases
455
456(deftest map-into.error.1
457  (check-type-error #'(lambda (x) (map-into x (constantly nil))) #'sequencep)
458  nil)
459
460;;; The next test was changed because if the first argument
461;;; is NIL, map-into is said to 'return nil immediately', so
462;;; the 'should be prepared' notation for the error checking
463;;; means that error checking may be skipped.
464(deftest map-into.error.2
465  (and (locally (declare (optimize (safety 3)))
466                (handler-case (eval '(map-into nil #'identity 'a))
467                              (type-error () nil)))
468       :bad)
469  nil)
470
471(deftest map-into.error.3
472  (check-type-error #'(lambda (x) (map-into (copy-seq '(a b c)) #'cons '(d e f) x))
473                    #'sequencep)
474  nil)
475
476(deftest map-into.error.4
477  (signals-error (map-into) program-error)
478  t)
479
480(deftest map-into.error.5
481  (signals-error (map-into (list 'a 'b 'c)) program-error)
482  t)
483
484(deftest map-into.error.6
485  (signals-error (locally (map-into 'a #'(lambda () nil)) t)
486                 type-error)
487  t)
488
489(deftest map-into.error.7
490  (signals-error (map-into (list 'a 'b 'c) #'cons '(a b c)) program-error)
491  t)
492
493(deftest map-into.error.8
494  (signals-error (map-into (list 'a 'b 'c) #'car '(a b c)) type-error)
495  t)
496
497;;; Order of evaluation tests
498
499(deftest map-into.order.1
500  (let ((i 0) a b c)
501    (values
502     (map-into (progn (setf a (incf i)) (list 1 2 3 4))
503               (progn (setf b (incf i)) #'identity)
504               (progn (setf c (incf i)) '(a b c d)))
505     i a b c))
506  (a b c d) 3 1 2 3)
507
508(deftest map-into.order.2
509  (let ((i 0) a b c d)
510    (values
511     (map-into (progn (setf a (incf i)) (list 1 2 3 4))
512               (progn (setf b (incf i)) #'list)
513               (progn (setf c (incf i)) '(a b c d))
514               (progn (setf d (incf i)) '(e f g h)))
515     i a b c d))
516  ((a e) (b f) (c g) (d h)) 4 1 2 3 4)
Note: See TracBrowser for help on using the repository browser.