source: trunk/source/tests/ansi-tests/map.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: 10.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Aug 17 20:54:48 2002
4;;;; Contains: Tests for the MAP function
5
6(in-package :cl-test)
7
8(deftest map-array.1
9  (map 'list #'1+ #(1 2 3 4))
10  (2 3 4 5))
11
12(deftest map-array.2
13  (map 'vector #'+ #(1 2 3 4) #(6 6 6 6))
14  #(7 8 9 10))
15
16(deftest map-array.3
17  (map 'vector #'+ #(1 2 3 4 5) #(6 6 6 6))
18  #(7 8 9 10))
19
20(deftest map-array.4
21  (map 'vector #'+ #(1 2 3 4) #(6 6 6 6 6))
22  #(7 8 9 10))
23
24(deftest map-array.5
25  (map '(vector *) #'+ #(1 2 3 4) #(6 6 6 6))
26  #(7 8 9 10))
27
28(deftest map-array.6
29  (map '(vector * 4) #'+ #(1 2 3 4) #(6 6 6 6))
30  #(7 8 9 10))
31
32;;; (deftest map-array.7
33;;;  (map 'array #'identity '(a b c d e f))
34;;;  #(a b c d e f))
35
36;;; (deftest map-array.8
37;;;   (map 'simple-array #'identity '(a b c d e f))
38;;;   #(a b c d e f))
39
40(deftest map-array.9
41  (map 'simple-vector #'identity '(a b c d e f))
42  #(a b c d e f))
43
44(deftest map-array.10
45  (map 'simple-vector #'cons '(a b c d e f) #(1 2 3 4 5 6))
46  #((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6)))
47
48(deftest map-array.11
49  (map 'vector #'identity '(#\a #\b #\c #\d #\e))
50  #(#\a #\b #\c #\d #\e))
51
52(deftest map-array.12
53  (map 'vector #'identity "abcde")
54  #(#\a #\b #\c #\d #\e))
55
56(deftest map-array.13
57  (map 'vector #'identity #*000001)
58  #(0 0 0 0 0 1))
59
60(deftest map-array.14
61  (map 'list #'identity #*000001)
62  (0 0 0 0 0 1))
63
64(deftest map-bit-vector.15
65  (map 'bit-vector #'identity '(0 0 0 0 0 1))
66  #*000001)
67
68(deftest map-bit-vector.16
69  (map 'simple-bit-vector #'identity '(0 0 0 0 0 1))
70  #*000001)
71
72(deftest map-bit-vector.17
73  (map '(vector bit) #'identity '(0 0 0 0 0 1))
74  #*000001)
75
76(deftest map-bit-vector.18
77  (map '(simple-vector *) #'identity '(0 0 0 0 0 1))
78  #*000001)
79
80(deftest map-bit-vector.19
81  (map '(bit-vector 6) #'identity '(0 0 0 0 0 1))
82  #*000001)
83
84(deftest map-bit-vector.20
85  (map '(bit-vector *) #'identity '(0 0 0 0 0 1))
86  #*000001)
87
88(deftest map-bit-vector.21
89  (map '(simple-bit-vector 6) #'identity '(0 0 0 0 0 1))
90  #*000001)
91
92(deftest map-bit-vector.22
93  (map '(simple-bit-vector *) #'identity '(0 0 0 0 0 1))
94  #*000001)
95
96(deftest map-bit-vector.23
97  (map '(vector bit 6) #'identity '(0 0 0 0 0 1))
98  #*000001)
99
100(deftest map-bit-vector.24
101  (map '(vector bit *) #'identity '(0 0 0 0 0 1))
102  #*000001)
103
104(deftest map-bit-vector.25
105  (map '(simple-vector 6) #'identity '(0 0 0 0 0 1))
106  #*000001)
107
108(deftest map-string.26
109  (map 'string #'identity '(#\a #\b #\c #\d #\e))
110  "abcde")
111
112(deftest map-string.27
113  (map 'string #'identity "abcde")
114  "abcde")
115
116(deftest map-string.28
117  (map '(vector character) #'identity '(#\a #\b #\c #\d #\e))
118  "abcde")
119
120(deftest map-string.29
121  (map '(vector character 5) #'identity '(#\a #\b #\c #\d #\e))
122  "abcde")
123
124(deftest map-string.30
125  (map '(simple-vector 5) #'identity '(#\a #\b #\c #\d #\e))
126  "abcde")
127
128;;; Use a more elaborate form of the simple-array type specifier
129;;; (deftest map-string.31
130;;;  (map '(simple-array character *) #'identity "abcde")
131;;;  "abcde")
132
133;;; Use a more elaborate form of the simple-array type specifier
134;;; (deftest map-string.32
135;;;  (map '(simple-array character 5) #'identity "abcde")
136;;;   "abcde")
137
138(deftest map-nil.33
139  (let ((a nil))
140    (values (map nil #'(lambda (x) (push x a)) "abcdef") a))
141  nil (#\f #\e #\d #\c #\b #\a))
142
143(deftest map-nil.34
144  (let ((a nil))
145    (values (map nil #'(lambda (x) (push x a)) '(a b c d e)) a))
146  nil (e d c b a))
147
148(deftest map-nil.35
149  (let ((a nil))
150    (values (map nil #'(lambda (x) (push x a)) #(a b c d e)) a))
151  nil (e d c b a))
152
153(deftest map-nil.36
154  (let ((a nil))
155    (values (map nil #'(lambda (x) (push x a)) #*001011110) a))
156  nil (0 1 1 1 1 0 1 0 0))
157
158(deftest map-null.1
159  (map 'null #'identity nil)
160  nil)
161
162(deftest map-cons.1
163  (map 'cons #'identity '(a b c))
164  (a b c))
165
166(deftest map.37
167  (map 'simple-string #'identity '(#\a #\b #\c))
168  "abc")
169
170(deftest map.38
171  (map '(simple-string) #'identity '(#\a #\b #\c))
172  "abc")
173
174(deftest map.39
175  (map '(simple-string *) #'identity '(#\a #\b #\c))
176  "abc")
177
178(deftest map.40
179  (map '(simple-string 3) #'identity '(#\a #\b #\c))
180  "abc")
181
182(deftest map.41
183  (map '(base-string) #'identity '(#\a #\b #\c))
184  "abc")
185
186(deftest map.42
187  (map '(base-string *) #'identity '(#\a #\b #\c))
188  "abc")
189
190(deftest map.43
191  (map '(base-string 3) #'identity '(#\a #\b #\c))
192  "abc")
193
194(deftest map.44
195  (map 'simple-base-string #'identity '(#\a #\b #\c))
196  "abc")
197
198(deftest map.45
199  (map '(simple-base-string) #'identity '(#\a #\b #\c))
200  "abc")
201
202(deftest map.46
203  (map '(simple-base-string *) #'identity '(#\a #\b #\c))
204  "abc")
205
206(deftest map.47
207  (map '(simple-base-string 3) #'identity '(#\a #\b #\c))
208  "abc")
209
210(deftest map.48
211  :notes (:result-type-element-type-by-subtype)
212  (let ((type '(or (vector t 10) (vector t 5))))
213    (if (subtypep type '(vector t))
214        (equalpt (map type #'identity '(1 2 3 4 5)) #(1 2 3 4 5))
215      t))
216  t)
217
218;;; Error tests
219
220(deftest map.error.1
221  (signals-error-always (map 'symbol #'identity '(a b c)) type-error)
222  t t)
223
224(deftest map.error.1a
225  (signals-error (map 'symbol #'identity '(a b c)) type-error)
226  t)
227
228(deftest map.error.2
229  (signals-error (map '(vector * 8) #'identity '(a b c)) type-error)
230  t)
231
232(deftest map.error.3
233  (signals-error (map 'list #'identity '(a b . c)) type-error)
234  t)
235
236(deftest map.error.4
237  (signals-error (map) program-error)
238  t)
239
240(deftest map.error.5
241  (signals-error (map 'list) program-error)
242  t)
243
244(deftest map.error.6
245  (signals-error (map 'list #'null) program-error)
246  t)
247
248(deftest map.error.7
249  (signals-error (map 'list #'cons '(a b c d)) program-error)
250  t)
251
252(deftest map.error.8
253  (signals-error (map 'list #'cons '(a b c d) '(1 2 3 4) '(5 6 7 8))
254                 program-error)
255  t)
256
257(deftest map.error.9
258  (signals-error (map 'list #'car '(a b c d)) type-error)
259  t)
260
261(deftest map.error.10
262  :notes (:result-type-element-type-by-subtype)
263  (let ((type '(or (vector bit) (vector t))))
264    (if (subtypep type 'vector)
265        (eval `(signals-error-always (map ',type #'identity '(1 0 1)) error))
266      (values t t)))
267  t t)
268
269(deftest map.error.11
270  (let ((type '(or (vector t 5) (vector t 10))))
271    (if (subtypep type 'vector)
272        (eval `(signals-error (map ',type #'identity '(1 2 3 4 5 6)) type-error))
273      t))
274  t)
275
276(deftest map.error.12
277  (check-type-error #'(lambda (x) (map 'list #'identity x)) #'sequencep)
278  nil)
279
280(deftest map.error.13
281  (check-type-error #'(lambda (x) (map 'vector #'cons '(a b c d) x)) #'sequencep)
282  nil)
283
284;;; Test mapping on arrays with fill pointers
285
286(deftest map.fill.1
287  (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j)
288                        :fill-pointer 8)))
289    (map 'list #'identity s1))
290  (a b c d e f g h))
291
292(deftest map.fill.2
293  (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j)
294                        :fill-pointer 8)))
295    (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
296  (1 2 3 4 5 6 7 8))
297
298(deftest map.fill.3
299  (let ((s1 (make-array '(10) :initial-element #\a
300                        :element-type 'character
301                        :fill-pointer 8)))
302    (map 'string #'identity s1))
303  "aaaaaaaa")
304 
305(deftest map.fill.4
306  (let ((s1 (make-array '(10) :initial-element #\a
307                        :element-type 'base-char
308                        :fill-pointer 8)))
309    (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
310  (1 2 3 4 5 6 7 8))
311
312(deftest map.fill.5
313  (let ((s1 (make-array '(10) :initial-element 0
314                        :element-type 'bit
315                        :fill-pointer 8)))
316    (map 'bit-vector #'identity s1))
317  #*00000000) 
318 
319(deftest map.fill.6
320  (let ((s1 (make-array '(10) :initial-element 1
321                        :element-type 'bit
322                        :fill-pointer 8)))
323    (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
324  (1 2 3 4 5 6 7 8))
325
326;;; Specialized string tests
327
328(deftest map.specialized-string.1
329  (do-special-strings
330   (s "abcde" nil)
331   (let ((s2 (map 'list #'identity s)))
332     (assert (equal s2 '(#\a #\b #\c #\d #\e)))))
333  nil)
334
335(deftest map.specialized-string.2
336  (do-special-strings
337   (s "abcde" nil)
338   (let ((s2 (map 'list #'(lambda (x y) y) '(1 2 3 4 5) s)))
339     (assert (equal s2 '(#\a #\b #\c #\d #\e)))))
340  nil)
341
342(deftest map.specialized-string.3
343  (let ((s (map 'base-string #'identity '(#\a #\b #\c))))
344    (assert (typep s 'base-string))
345    s)
346  "abc")
347
348;;; FIXME: Add tests for building strings of other character types
349
350;;; Special vector types
351
352(deftest map.specialized-vector.1
353  (do-special-integer-vectors
354   (v #(0 1 1 0 0 1) nil)
355   (assert (equal (map 'list #'list v v) '((0 0) (1 1) (1 1) (0 0) (0 0) (1 1)))))
356  nil)
357
358(deftest map.specialized-vector.2
359  (do-special-integer-vectors
360   (v #(1 2 3 4 5 6 7) nil)
361   (assert (equal (map 'list #'identity v) '(1 2 3 4 5 6 7))))
362  nil)
363
364(deftest map.specialized-vector.3
365  (do-special-integer-vectors
366   (v #(-1 -2 -3 -4 -5 -6 -7) nil)
367   (assert (equal (map 'list #'- v) '(1 2 3 4 5 6 7))))
368  nil)
369
370(deftest map.specialized-vector.4
371  (loop for i from 1 to 40
372        for type = `(unsigned-byte ,i)
373        for bound = (ash 1 i)
374        for len = 10
375        for vals = (loop repeat len collect (random i))
376        for result = (map `(vector ,type) #'identity vals)
377        unless (and (= (length result) len)
378                    (every #'eql vals result))
379        collect (list i vals result))
380  nil)
381
382(deftest map.specialized-vector.5
383  (loop for i from 1 to 40
384        for type = `(signed-byte ,i)
385        for bound = (ash 1 i)
386        for len = 10
387        for vals = (loop repeat len collect (- (random i) (/ bound 2)))
388        for result = (map `(vector ,type) #'identity vals)
389        unless (and (= (length result) len)
390                    (every #'eql vals result))
391        collect (list i vals result))
392  nil)
393
394(deftest map.specialized-vector.6
395  (loop for type in '(short-float single-float long-float double-float)
396        for len = 10
397        for vals = (loop for i from 1 to len collect (coerce i type))
398        for result = (map `(vector ,type) #'identity vals)
399        unless (and (= (length result) len)
400                    (every #'eql vals result))
401        collect (list type vals result))
402  nil)
403
404(deftest map.specialized-vector.7
405  (loop for etype in '(short-float single-float long-float double-float
406                       integer rational)
407        for type = `(complex ,etype)
408        for len = 10
409        for vals = (loop for i from 1 to len collect (complex (coerce i etype)
410                                                              (coerce (- i) etype)))
411        for result = (map `(vector ,type) #'identity vals)
412        unless (and (= (length result) len)
413                    (every #'eql vals result))
414        collect (list type vals result))
415  nil)
416
417;;; Order of evaluation tests
418
419(deftest map.order.1
420  (let ((i 0) a b c d)
421    (values
422     (map (progn (setf a (incf i)) 'list)
423          (progn (setf b (incf i)) #'list)
424          (progn (setf c (incf i)) '(a b c))
425          (progn (setf d (incf i)) '(b c d)))
426     i a b c d))
427  ((a b)(b c)(c d)) 4 1 2 3 4)
428
429;;; Constant folding test
430
431(def-fold-test map.fold.1 (map 'vector #'identity '(a b c)))
Note: See TracBrowser for help on using the repository browser.