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