source: trunk/source/tests/ansi-tests/do.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: 3.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jan  8 07:25:18 2005
4;;;; Contains: Tests of DO
5
6(in-package :cl-test)
7
8
9(deftest do.1
10  (do ((i 0 (1+ i)))
11      ((>= i 10) i))
12  10)
13
14(deftest do.2
15  (do ((i 0 (1+ j))
16       (j 0 (1+ i)))
17      ((>= i 10) (+ i j)))
18  20)
19
20(deftest do.3
21  (let ((x nil))
22    (do ((i 0 (1+ i)))
23        ((>= i 10) x)
24      (push i x)))
25  (9 8 7 6 5 4 3 2 1 0))
26
27(deftest do.4
28  (let ((x nil))
29    (do ((i 0 (1+ i)))
30        ((>= i 10) x)
31      (declare (fixnum i))
32      (push i x)))
33  (9 8 7 6 5 4 3 2 1 0))
34
35(deftest do.5
36  (do ((i 0 (1+ i)))
37      (nil)
38    (when (> i 10) (return i)))
39  11)
40
41;;; Zero iterations
42(deftest do.6
43  (do ((i 0 (+ i 10)))
44      ((> i -1) i)
45    (return 'bad))
46  0)
47
48;;; Tests of go tags
49(deftest do.7
50  (let ((x nil))
51    (do ((i 0 (1+ i)))
52        ((>= i 10) x)
53      (go around)
54      small
55      (push 'a x)
56      (go done)
57      big
58      (push 'b x)
59      (go done)
60      around
61      (if (> i 4) (go big) (go small))
62      done))
63  (b b b b b a a a a a))
64
65;;; No increment form
66(deftest do.8
67  (do ((i 0 (1+ i))
68       (x nil))
69      ((>= i 10) x)
70    (push 'a x))
71  (a a a a a a a a a a))
72
73;;; No do locals
74(deftest do.9
75  (let ((i 0))
76    (do ()
77        ((>= i 10) i)
78      (incf i)))
79  10)
80
81;;; Return of no values
82(deftest do.10
83  (do ((i 0 (1+ i)))
84      ((> i 10) (values))))
85
86;;; Return of two values
87(deftest do.11
88  (do ((i 0 (1+ i)))
89      ((> i 10) (values i (1+ i))))
90  11 12)
91
92;;; The results* list is an implicit progn
93(deftest do.12
94  (do ((i 0 (1+ i)))
95      ((> i 10) (incf i) (incf i) i))
96  13)
97
98(deftest do.13
99  (do ((i 0 (1+ i)))
100      ((> i 10)))
101  nil)
102
103;; Special var
104(deftest do.14
105  (let ((x 0))
106    (flet ((%f () (locally (declare (special i))
107                           (incf x i))))
108      (do ((i 0 (1+ i)))
109          ((>= i 10) x)
110        (declare (special i))
111        (%f))))
112  45)
113
114;;; Confirm that the variables in succesive iterations are
115;;; identical
116(deftest do.15
117  (mapcar #'funcall
118          (let ((x nil))
119            (do ((i 0 (1+ i)))
120                ((= i 5) x)
121              (push #'(lambda () i) x))))
122  (5 5 5 5 5))
123
124;;; Scope of free declarations
125
126(deftest do.16
127  (block done
128    (let ((x :bad))
129      (declare (special x))
130      (let ((x :good))
131        (do ((i (return-from done x) 0))
132            (t nil)
133          (declare (special x))))))
134  :good)
135
136(deftest do.17
137  (block done
138    (let ((x :good))
139      (declare (special x))
140      (let ((x :bad))
141        (do ((i 0 (return-from done x)))
142            (nil nil)
143          (declare (special x))))))
144  :good)
145
146(deftest do.18
147  (block done
148    (let ((x :good))
149      (declare (special x))
150      (let ((x :bad))
151        (do ((i 0 0))
152            ((return-from done x) nil)
153          (declare (special x))))))
154  :good)
155
156(deftest do.19
157  (let ((x :good))
158    (declare (special x))
159    (let ((x :bad))
160      (do () (t x)
161        (declare (special x)))))
162  :good)
163
164;;; Test that explicit calls to macroexpand in subforms
165;;; are done in the correct environment
166
167(deftest do.20
168  (let ((result nil))
169    (macrolet
170     ((%m (z) z))
171     (do ((x (expand-in-current-env (%m 0)) (+ x 2)))
172         ((> x 10) result)
173         (push x result))))
174  (10 8 6 4 2 0))
175
176(deftest do.21
177  (let ((result nil))
178    (macrolet
179     ((%m (z) z))
180     (do ((x 0 (expand-in-current-env (%m (+ x 2)))))
181         ((> x 10) result)
182         (push x result))))
183  (10 8 6 4 2 0))
184
185(deftest do.22
186  (let ((result nil))
187    (macrolet
188     ((%m (z) z))
189     (do ((x 0 (+ x 2)))
190         ((expand-in-current-env (%m (> x 10))) result)
191         (push x result))))
192  (10 8 6 4 2 0))
193
194(deftest do.23
195  (let ((result nil))
196    (macrolet
197     ((%m (z) z))
198     (do ((x 0 (+ x 2)))
199         ((> x 10) (expand-in-current-env (%m result)))
200         (push x result))))
201  (10 8 6 4 2 0))
202
203(def-macro-test do.error.1
204  (do ((i 0 (1+ i))) ((= i 5) 'a)))
Note: See TracBrowser for help on using the repository browser.