source: trunk/tests/ansi-tests/map.lsp @ 9045

Last change on this file since 9045 was 9045, checked in by gz, 12 years ago

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

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#+known-bug-276
270(deftest map.error.11
271  (let ((type '(or (vector t 5) (vector t 10))))
272    (if (subtypep type 'vector)
273        (eval `(signals-error (map ',type #'identity '(1 2 3 4 5 6)) type-error))
274      t))
275  t)
276
277(deftest map.error.12
278  (check-type-error #'(lambda (x) (map 'list #'identity x)) #'sequencep)
279  nil)
280
281(deftest map.error.13
282  (check-type-error #'(lambda (x) (map 'vector #'cons '(a b c d) x)) #'sequencep)
283  nil)
284
285;;; Test mapping on arrays with fill pointers
286
287(deftest map.fill.1
288  (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j)
289                        :fill-pointer 8)))
290    (map 'list #'identity s1))
291  (a b c d e f g h))
292
293(deftest map.fill.2
294  (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j)
295                        :fill-pointer 8)))
296    (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
297  (1 2 3 4 5 6 7 8))
298
299(deftest map.fill.3
300  (let ((s1 (make-array '(10) :initial-element #\a
301                        :element-type 'character
302                        :fill-pointer 8)))
303    (map 'string #'identity s1))
304  "aaaaaaaa")
305 
306(deftest map.fill.4
307  (let ((s1 (make-array '(10) :initial-element #\a
308                        :element-type 'base-char
309                        :fill-pointer 8)))
310    (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
311  (1 2 3 4 5 6 7 8))
312
313(deftest map.fill.5
314  (let ((s1 (make-array '(10) :initial-element 0
315                        :element-type 'bit
316                        :fill-pointer 8)))
317    (map 'bit-vector #'identity s1))
318  #*00000000) 
319 
320(deftest map.fill.6
321  (let ((s1 (make-array '(10) :initial-element 1
322                        :element-type 'bit
323                        :fill-pointer 8)))
324    (map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
325  (1 2 3 4 5 6 7 8))
326
327;;; Specialized string tests
328
329(deftest map.specialized-string.1
330  (do-special-strings
331   (s "abcde" nil)
332   (let ((s2 (map 'list #'identity s)))
333     (assert (equal s2 '(#\a #\b #\c #\d #\e)))))
334  nil)
335
336(deftest map.specialized-string.2
337  (do-special-strings
338   (s "abcde" nil)
339   (let ((s2 (map 'list #'(lambda (x y) y) '(1 2 3 4 5) s)))
340     (assert (equal s2 '(#\a #\b #\c #\d #\e)))))
341  nil)
342
343(deftest map.specialized-string.3
344  (let ((s (map 'base-string #'identity '(#\a #\b #\c))))
345    (assert (typep s 'base-string))
346    s)
347  "abc")
348
349;;; FIXME: Add tests for building strings of other character types
350
351;;; Special vector types
352
353(deftest map.specialized-vector.1
354  (do-special-integer-vectors
355   (v #(0 1 1 0 0 1) nil)
356   (assert (equal (map 'list #'list v v) '((0 0) (1 1) (1 1) (0 0) (0 0) (1 1)))))
357  nil)
358
359(deftest map.specialized-vector.2
360  (do-special-integer-vectors
361   (v #(1 2 3 4 5 6 7) nil)
362   (assert (equal (map 'list #'identity v) '(1 2 3 4 5 6 7))))
363  nil)
364
365(deftest map.specialized-vector.3
366  (do-special-integer-vectors
367   (v #(-1 -2 -3 -4 -5 -6 -7) nil)
368   (assert (equal (map 'list #'- v) '(1 2 3 4 5 6 7))))
369  nil)
370
371(deftest map.specialized-vector.4
372  (loop for i from 1 to 40
373        for type = `(unsigned-byte ,i)
374        for bound = (ash 1 i)
375        for len = 10
376        for vals = (loop repeat len collect (random i))
377        for result = (map `(vector ,type) #'identity vals)
378        unless (and (= (length result) len)
379                    (every #'eql vals result))
380        collect (list i vals result))
381  nil)
382
383(deftest map.specialized-vector.5
384  (loop for i from 1 to 40
385        for type = `(signed-byte ,i)
386        for bound = (ash 1 i)
387        for len = 10
388        for vals = (loop repeat len collect (- (random i) (/ bound 2)))
389        for result = (map `(vector ,type) #'identity vals)
390        unless (and (= (length result) len)
391                    (every #'eql vals result))
392        collect (list i vals result))
393  nil)
394
395(deftest map.specialized-vector.6
396  (loop for type in '(short-float single-float long-float double-float)
397        for len = 10
398        for vals = (loop for i from 1 to len collect (coerce i type))
399        for result = (map `(vector ,type) #'identity vals)
400        unless (and (= (length result) len)
401                    (every #'eql vals result))
402        collect (list type vals result))
403  nil)
404
405(deftest map.specialized-vector.7
406  (loop for etype in '(short-float single-float long-float double-float
407                       integer rational)
408        for type = `(complex ,etype)
409        for len = 10
410        for vals = (loop for i from 1 to len collect (complex (coerce i etype)
411                                                              (coerce (- i) etype)))
412        for result = (map `(vector ,type) #'identity vals)
413        unless (and (= (length result) len)
414                    (every #'eql vals result))
415        collect (list type vals result))
416  nil)
417
418;;; Order of evaluation tests
419
420(deftest map.order.1
421  (let ((i 0) a b c d)
422    (values
423     (map (progn (setf a (incf i)) 'list)
424          (progn (setf b (incf i)) #'list)
425          (progn (setf c (incf i)) '(a b c))
426          (progn (setf d (incf i)) '(b c d)))
427     i a b c d))
428  ((a b)(b c)(c d)) 4 1 2 3 4)
429
430;;; Constant folding test
431
432(def-fold-test map.fold.1 (map 'vector #'identity '(a b c)))
Note: See TracBrowser for help on using the repository browser.