1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sun Oct 27 08:36:36 2002 |
---|
4 | ;;;; Contains: Tests of FOR-ON-AS-LIST iteration control in LOOP |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (deftest loop.3.1 |
---|
9 | (loop for x on '(1 2 3) sum (car x)) |
---|
10 | 6) |
---|
11 | |
---|
12 | (deftest loop.3.2 |
---|
13 | (loop for x on '(1 2 3 4) |
---|
14 | do (when (evenp (car x)) (return x))) |
---|
15 | (2 3 4)) |
---|
16 | |
---|
17 | |
---|
18 | (deftest loop.3.3 |
---|
19 | (loop for x on '(a b c . d) collect (car x)) |
---|
20 | (a b c)) |
---|
21 | |
---|
22 | (deftest loop.3.4 |
---|
23 | (let ((x nil)) |
---|
24 | (loop for e on '(a b c d) do (push (car e) x)) |
---|
25 | x) |
---|
26 | (d c b a)) |
---|
27 | |
---|
28 | (deftest loop.3.5 |
---|
29 | (loop for e on '(a b c d e f) by #'cddr |
---|
30 | collect (car e)) |
---|
31 | (a c e)) |
---|
32 | |
---|
33 | (deftest loop.3.6 |
---|
34 | (loop for e on '(a b c d e f g) by #'cddr |
---|
35 | collect (car e)) |
---|
36 | (a c e g)) |
---|
37 | |
---|
38 | (deftest loop.3.7 |
---|
39 | (loop for e on '(a b c d e f) |
---|
40 | by #'(lambda (l) (and (cdr l) (cons (car l) (cddr l)))) |
---|
41 | collect (car e)) |
---|
42 | (a a a a a a)) |
---|
43 | |
---|
44 | (deftest loop.3.8 |
---|
45 | (loop for ((x . y)) on '((a . b) (c . d) (e . f)) |
---|
46 | collect (list x y)) |
---|
47 | ((a b) (c d) (e f))) |
---|
48 | |
---|
49 | (deftest loop.3.9 |
---|
50 | (loop for ((x nil y)) on '((a b c) (d e f) (g h i)) |
---|
51 | collect (list x y)) |
---|
52 | ((a c) (d f) (g i))) |
---|
53 | |
---|
54 | (deftest loop.3.10 |
---|
55 | (loop for ((x y)) of-type (fixnum) on '((1 2) (3 4) (5 6)) |
---|
56 | collect (+ x y)) |
---|
57 | (3 7 11)) |
---|
58 | |
---|
59 | (deftest loop.3.11 |
---|
60 | (loop for ((x y)) of-type (fixnum) on '((1 2) (3 4) (5 6)) |
---|
61 | collect (+ x y)) |
---|
62 | (3 7 11)) |
---|
63 | |
---|
64 | (deftest loop.3.12 |
---|
65 | (loop for ((x y)) of-type ((fixnum fixnum)) on '((1 2) (3 4) (5 6)) |
---|
66 | collect (+ x y)) |
---|
67 | (3 7 11)) |
---|
68 | |
---|
69 | (deftest loop.3.13 |
---|
70 | (loop for ((x . y)) of-type ((fixnum . fixnum)) on '((1 . 2) (3 . 4) (5 . 6)) |
---|
71 | collect (+ x y)) |
---|
72 | (3 7 11)) |
---|
73 | |
---|
74 | (deftest loop.3.14 |
---|
75 | (signals-error |
---|
76 | (loop for x on '(a b c) |
---|
77 | for x on '(d e f) collect x) |
---|
78 | program-error) |
---|
79 | t) |
---|
80 | |
---|
81 | (deftest loop.3.15 |
---|
82 | (signals-error (loop for (x . x) on '((a b) (c d)) collect x) |
---|
83 | program-error) |
---|
84 | t) |
---|
85 | |
---|
86 | (deftest loop.3.16 |
---|
87 | (loop for nil on nil do (return t)) |
---|
88 | nil) |
---|
89 | |
---|
90 | (deftest loop.3.17 |
---|
91 | (let ((x '(a b c))) |
---|
92 | (values |
---|
93 | x |
---|
94 | (loop for x on '(d e f) collect x) |
---|
95 | x)) |
---|
96 | (a b c) |
---|
97 | ((d e f) (e f) (f)) |
---|
98 | (a b c)) |
---|
99 | |
---|
100 | (deftest loop.3.18 |
---|
101 | (loop for (x) of-type ((integer 0 10)) on '(2 4 6 7) sum x) |
---|
102 | 19) |
---|
103 | |
---|
104 | ;;; Tests of the 'AS' form |
---|
105 | |
---|
106 | (deftest loop.3.19 |
---|
107 | (loop as x on '(1 2 3) sum (car x)) |
---|
108 | 6) |
---|
109 | |
---|
110 | (deftest loop.3.20 |
---|
111 | (loop as x on '(a b c) |
---|
112 | as y on '(1 2 3) |
---|
113 | collect (list (car x) (car y))) |
---|
114 | ((a 1) (b 2) (c 3))) |
---|
115 | |
---|
116 | (deftest loop.3.21 |
---|
117 | (loop as x on '(a b c) |
---|
118 | for y on '(1 2 3) |
---|
119 | collect (list (car x) (car y))) |
---|
120 | ((a 1) (b 2) (c 3))) |
---|
121 | |
---|
122 | (deftest loop.3.22 |
---|
123 | (loop for x on '(a b c) |
---|
124 | as y on '(1 2 3) |
---|
125 | collect (list (car x) (car y))) |
---|
126 | ((a 1) (b 2) (c 3))) |
---|
127 | |
---|
128 | (deftest loop.3.23 |
---|
129 | (let (a b (i 0)) |
---|
130 | (values |
---|
131 | (loop for e on (progn (setf a (incf i)) |
---|
132 | '(a b c d e f g)) |
---|
133 | by (progn (setf b (incf i)) #'cddr) |
---|
134 | collect (car e)) |
---|
135 | a b i)) |
---|
136 | (a c e g) |
---|
137 | 1 2 2) |
---|
138 | |
---|
139 | ;;; Test that explicit calls to macroexpand in subforms |
---|
140 | ;;; are done in the correct environment |
---|
141 | |
---|
142 | (deftest loop.3.24 |
---|
143 | (macrolet |
---|
144 | ((%m (z) z)) |
---|
145 | (loop for x on (expand-in-current-env (%m '(1 2 3))) sum (car x))) |
---|
146 | 6) |
---|
147 | |
---|
148 | (deftest loop.3.25 |
---|
149 | (macrolet |
---|
150 | ((%m (z) z)) |
---|
151 | (loop for e on (expand-in-current-env (%m '(a b c d e f))) by #'cddr |
---|
152 | collect (car e))) |
---|
153 | (a c e)) |
---|
154 | |
---|
155 | (deftest loop.3.26 |
---|
156 | (macrolet |
---|
157 | ((%m (z) z)) |
---|
158 | (loop for e on '(a b c d e f) |
---|
159 | by (expand-in-current-env (%m #'cddr)) |
---|
160 | collect (car e))) |
---|
161 | (a c e)) |
---|
162 | |
---|
163 | (deftest loop.3.27 |
---|
164 | (macrolet |
---|
165 | ((%m (z) z)) |
---|
166 | (loop as x on (expand-in-current-env (%m '(1 2 3))) sum (car x))) |
---|
167 | 6) |
---|