source: trunk/source/tests/ansi-tests/dotimes.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: 3.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jan  8 07:27:15 2005
4;;;; Contains: Tests of DOTIMES
5
6(in-package :cl-test)
7
8
9(deftest dotimes.1
10  (dotimes (i 10))
11  nil)
12
13(deftest dotimes.2
14  (dotimes (i 10 'a))
15  a)
16
17(deftest dotimes.3
18  (dotimes (i 10 (values))))
19
20(deftest dotimes.3a
21  (dotimes (i 10 (values 'a 'b 'c)))
22  a b c)
23
24(deftest dotimes.4
25  (let ((x nil))
26    (dotimes (i 5 x) (push i x)))
27  (4 3 2 1 0))
28
29(deftest dotimes.5
30  (let ((x nil))
31    (dotimes (i 0 x) (push i x)))
32  nil)
33
34(deftest dotimes.6
35  (block done
36    (dotimes (i -1 'good)
37      (return-from done 'bad)))
38  good)
39
40(deftest dotimes.7
41  (block done
42    (dotimes (i (1- most-negative-fixnum) 'good)
43      (return-from done 'bad)))
44  good)
45
46;;; Implicit nil block has the right scope
47(deftest dotimes.8
48  (block nil
49    (dotimes (i (return 1)))
50    2)
51  2)
52
53(deftest dotimes.9
54  (block nil
55    (dotimes (i 10 (return 1)))
56    2)
57  2)
58
59(deftest dotimes.10
60  (block nil
61    (dotimes (i 10) (return 1))
62    2)
63  2)
64
65(deftest dotimes.11
66  (let ((x nil))
67    (dotimes (i 10)
68      (push i x)
69      (when (= i 5) (return x))))
70  (5 4 3 2 1 0))
71
72;;; Check there's an implicit tagbody
73(deftest dotimes.12
74  (let ((even nil)
75        (odd nil))
76    (dotimes (i 8 (values (reverse even)
77                          (reverse odd)))
78      (when (evenp i) (go even))
79      (push i odd)
80      (go done)
81      even
82      (push i even)
83      done))
84  (0 2 4 6)
85  (1 3 5 7))
86
87;;; Check that at the time the result form is evaluated,
88;;; the index variable is set to the number of times the loop
89;;; was executed.
90
91(deftest dotimes.13
92  (let ((i 100))
93    (dotimes (i 10 i)))
94  10)
95
96(deftest dotimes.14
97  (let ((i 100))
98    (dotimes (i 0 i)))
99  0)
100
101(deftest dotimes.15
102  (let ((i 100))
103    (dotimes (i -1 i)))
104  0)
105
106;;; Check that the variable is not bound in the count form
107(deftest dotimes.16
108  (let ((i nil))
109    (values
110     i
111     (dotimes (i (progn (setf i 'a) 10) i))
112     i))
113  nil 10 a)
114
115;;; Check special variable decls
116(deftest dotimes.17
117  (let ((i 0) (y nil))
118    (declare (special i))
119    (flet ((%f () i))
120      (dotimes (i 4)
121        (push (%f) y)))
122    y)
123  (0 0 0 0))
124
125(deftest dotimes.17a
126  (let ((i 0) (y nil) (bound 4))
127    (declare (special i))
128    (flet ((%f () i))
129      (dotimes (i bound)
130        (push (%f) y)))
131    y)
132  (0 0 0 0))
133
134(deftest dotimes.18
135  (let ((i 0) (y nil))
136    (declare (special i))
137    (flet ((%f () i))
138      (dotimes (i 4)
139        (declare (special i))
140        (push (%f) y)))
141    y)
142  (3 2 1 0))
143
144(deftest dotimes.18a
145  (let ((i 0) (y nil) (bound 4))
146    (declare (special i))
147    (flet ((%f () i))
148      (dotimes (i bound)
149        (declare (special i))
150        (push (%f) y)))
151    y)
152  (3 2 1 0))
153
154(deftest dotimes.19
155  (dotimes (i 100 i))
156  100)
157
158(deftest dotimes.20
159  (dotimes (i -100 i))
160  0)
161
162(deftest dotimes.21
163  (let ((x 0))
164    (dotimes (i (1- most-negative-fixnum) (values i x))
165      (declare (type fixnum i))
166      (incf x)))
167  0 0)
168
169;;; Scope of free declarations
170
171(deftest dotimes.22
172  (block done
173    (let ((x :bad))
174      (declare (special x))
175      (let ((x :good))
176        (dotimes (i (return-from done x))
177          (declare (special x))))))
178  :good)
179
180(deftest dotimes.23
181  (let ((x :good))
182    (declare (special x))
183    (let ((x :bad))
184      (dotimes (i 10 x)
185        (declare (special x)))))
186  :good)
187
188(deftest dotimes.23a
189  (let ((x :good) (bound 10))
190    (declare (special x))
191    (let ((x :bad))
192      (dotimes (i bound x)
193        (declare (special x)))))
194  :good)
195
196(deftest dotimes.24
197  (let ((bound 4) (j 0))
198    (values
199     (dotimes (i bound)
200       (incf j) (decf bound))
201     bound j))
202  nil 0 4)
203
204;;; Test that explicit calls to macroexpand in subforms
205;;; are done in the correct environment
206
207(deftest dotimes.25
208  (macrolet
209   ((%m (z) z))
210   (let (result)
211     (dotimes (i (expand-in-current-env (%m 4)) result)
212       (push i result))))
213  (3 2 1 0))
214
215(deftest dotimes.26
216  (macrolet
217   ((%m (z) z))
218   (let (result)
219     (dotimes (i 4 (expand-in-current-env (%m result)))
220       (push i result))))
221  (3 2 1 0))
222
223(def-macro-test dotimes.error.1
224  (dotimes (i 10)))
Note: See TracBrowser for help on using the repository browser.