source: trunk/source/tests/ansi-tests/loop9.lsp @ 8991

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

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 5.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Nov 14 06:25:21 2002
4;;;; Contains: Tests for loop list accumulation clauses
5
6(in-package :cl-test)
7
8;;; Tests of COLLECT, COLLECTING
9
10(deftest loop.9.1
11  (loop for x in '(2 3 4) collect (1+ x))
12  (3 4 5))
13
14(deftest loop.9.2
15  (loop for x in '(2 3 4) collecting (1+ x))
16  (3 4 5))
17
18(deftest loop.9.3
19  (loop for x in '(0 1 2)
20        when (eql x 2) do (return 'good)
21        collect x)
22  good)
23
24(deftest loop.9.4
25  (loop for x in '(a b c)
26        collect (list x) into foo
27        finally (return (reverse foo)))
28  ((c) (b) (a)))
29
30(deftest loop.9.5
31  (loop for x in '(a b c)
32        collecting (list x) into foo
33        finally (return (reverse foo)))
34  ((c) (b) (a)))
35
36(deftest loop.9.6
37  (loop for x from 1 to 10
38        when (evenp x) collect x into foo
39        when (oddp x)  collect x into bar
40        finally (return (list foo bar)))
41  ((2 4 6 8 10) (1 3 5 7 9)))
42
43(deftest loop.9.7
44  (loop for x from 1 to 10
45        collect (if (> x 5) (loop-finish) x))
46  (1 2 3 4 5))
47
48(deftest loop.9.8
49  (loop for x from 1 to 20
50        when (eql (mod x 5) 0) collect x into foo
51        when (eql (mod x 5) 2) collect x into foo
52        finally (return foo))
53  (2 5 7 10 12 15 17 20))
54
55(deftest loop.9.9
56  (loop for x from 1 to 20
57        when (eql (mod x 5) 0) collecting x into foo
58        when (eql (mod x 5) 2) collecting x into foo
59        finally (return foo))
60  (2 5 7 10 12 15 17 20))
61
62(deftest loop.9.10
63  (signals-error
64   (loop with foo = '(a b)
65         for x in '(c d) collect x into foo
66         finally (return foo))
67   program-error)
68  t)
69
70(deftest loop.9.11
71  (signals-error
72   (loop with foo = '(a b)
73         for x in '(c d) collecting x into foo
74         finally (return foo))
75   program-error)
76  t)
77
78(deftest loop.9.12
79  (let ((foo '(a b)))
80    (values
81     (loop for x in '(c d e) collect x into foo finally (return foo))
82     foo))
83  (c d e)
84  (a b))
85
86;;; Tests of APPEND, APPENDING
87
88(deftest loop.9.20
89  (loop for x in '((a b) (c d) (e f g) () (i)) append x)
90  (a b c d e f g i))
91
92(deftest loop.9.21
93  (loop for x in '((a b) (c d) (e f g) () (i)) appending x)
94  (a b c d e f g i))
95
96(deftest loop.9.22
97  (loop for x in '((a) (b) (c . whatever)) append x)
98  (a b c . whatever))
99
100(deftest loop.9.23
101  (loop for x in '((a) (b) (c . whatever)) appending x)
102  (a b c . whatever))
103
104(deftest loop.9.24
105  (loop for x in '(a b c d)
106        append (list x)
107        when (eq x 'b) append '(1 2 3)
108        when (eq x 'd) appending '(4 5 6))
109  (a b 1 2 3 c d 4 5 6))
110
111(deftest loop.9.25
112  (let (z)
113    (values
114     (loop for x in '((a) (b) (c) (d))
115           append x into foo
116           finally (setq z foo))
117     z))
118  nil
119  (a b c d))
120
121(deftest loop.9.26
122  (loop for x in '((a) (b) (c) (d))
123        for i from 1
124        append x into foo
125        append x into foo
126        appending (list i) into foo
127        finally (return foo))
128  (a a 1 b b 2 c c 3 d d 4))
129
130(deftest loop.9.27
131  (signals-error
132   (loop with foo = '(a b)
133         for x in '(c d) append (list x) into foo
134         finally (return foo))
135   program-error)
136  t)
137
138(deftest loop.9.28
139  (signals-error
140   (loop with foo = '(a b)
141         for x in '(c d) appending (list x) into foo
142         finally (return foo))
143   program-error)
144  t)
145
146
147;;; NCONC, NCONCING
148
149(deftest loop.9.30
150  (loop for x in '((a b) (c d) (e f g) () (i)) nconc (copy-seq x))
151  (a b c d e f g i))
152
153(deftest loop.9.31
154  (loop for x in '((a b) (c d) (e f g) () (i)) nconcing (copy-seq x))
155  (a b c d e f g i))
156
157(deftest loop.9.32
158  (loop for x in '((a) (b) (c . whatever)) nconc (cons (car x) (cdr x)))
159  (a b c . whatever))
160
161(deftest loop.9.33
162  (loop for x in '((a) (b) (c . whatever)) nconcing (cons (car x) (cdr x)))
163  (a b c . whatever))
164
165(deftest loop.9.34
166  (loop for x in '(a b c d)
167        nconc (list x)
168        when (eq x 'b) nconc (copy-seq '(1 2 3))
169        when (eq x 'd) nconcing (copy-seq '(4 5 6)))
170  (a b 1 2 3 c d 4 5 6))
171
172(deftest loop.9.35
173  (let (z)
174    (values
175     (loop for x in '((a) (b) (c) (d))
176           nconc (copy-seq x) into foo
177           finally (setq z foo))
178     z))
179  nil
180  (a b c d))
181
182(deftest loop.9.36
183  (loop for x in '((a) (b) (c) (d))
184        for i from 1
185        nconc (copy-seq x) into foo
186        nconc (copy-seq x) into foo
187        nconcing (list i) into foo
188        finally (return foo))
189  (a a 1 b b 2 c c 3 d d 4))
190
191(deftest loop.9.37
192  (signals-error
193   (loop with foo = '(a b)
194         for x in '(c d) nconc (list x) into foo
195         finally (return foo))
196   program-error)
197  t)
198
199(deftest loop.9.38
200  (signals-error
201   (loop with foo = '(a b)
202         for x in '(c d) nconcing (list x) into foo
203         finally (return foo))
204   program-error)
205  t)
206
207;;; Combinations
208
209(deftest loop.9.40
210  (loop for x in '(1 2 3 4 5 6 7)
211        if (< x 2) append (list x)
212        else if (< x 5) nconc (list (1+ x))
213        else collect (+ x 2))
214  (1 3 4 5 7 8 9))
215
216(deftest loop.9.41
217  (loop for x in '(1 2 3 4 5 6 7)
218        if (< x 2) append (list x) into foo
219        else if (< x 5) nconc (list (1+ x)) into foo
220        else collect (+ x 2) into foo
221        finally (return foo))
222  (1 3 4 5 7 8 9))
223
224;;; More nconc tests
225
226(deftest loop.9.42
227  (loop for x in '(a b c d e) nconc (cons x 'foo))
228  (a b c d e . foo))
229
230;;; Test that explicit calls to macroexpand in subforms
231;;; are done in the correct environment
232
233(deftest loop.9.43
234  (macrolet
235   ((%m (z) z))
236   (loop for x in '(1 2 3) collect (expand-in-current-env (%m (- x)))))
237  (-1 -2 -3))
238
239(deftest loop.9.44
240  (macrolet
241   ((%m (z) z))
242   (loop for x in '(1 2 3) collecting (expand-in-current-env (%m (list x)))))
243  ((1) (2) (3)))
244
245(deftest loop.9.45
246  (macrolet
247   ((%m (z) z))
248   (loop for x in '(a b c)
249         collect (expand-in-current-env (%m (list x))) into foo
250         finally (return (reverse foo))))
251  ((c) (b) (a)))
252
253(deftest loop.9.46
254  (macrolet
255   ((%m (z) z))
256   (loop for x in '((a b) (c d) (e f g) () (i))
257         append (expand-in-current-env (%m x))))
258  (a b c d e f g i))
259
260(deftest loop.9.47
261  (macrolet
262   ((%m (z) z))
263   (loop for x in '((a b) (c d) (e f g) () (i))
264         nconc (expand-in-current-env (%m (copy-seq x)))))
265  (a b c d e f g i))
Note: See TracBrowser for help on using the repository browser.