source: trunk/source/tests/ansi-tests/labels.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: 8.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Oct  9 19:06:33 2002
4;;;; Contains: Tests of LABELS
5
6(in-package :cl-test)
7
8(deftest labels.1
9  (labels ((%f () 1))
10    (%f))
11  1)
12
13(deftest labels.2
14  (labels ((%f (x) x))
15    (%f 2))
16  2)
17
18(deftest labels.3
19  (labels ((%f (&rest args) args))
20    (%f 'a 'b 'c))
21  (a b c))
22
23;;; The optional arguments are not in the block defined by
24;;; the local function declaration
25(deftest labels.4
26  (block %f
27    (labels ((%f (&optional (x (return-from %f :good)))
28               nil))
29      (%f)
30      :bad))
31  :good)
32
33;;; Keyword parameter initializers are not in the blocked defined
34;;; by the local function declaration
35
36(deftest labels.4a
37  (block %f
38    (labels ((%f (&key (x (return-from %f :good)))
39               nil))
40      (%f)
41      :bad))
42  :good)
43
44(deftest labels.5
45  (labels ((%f () (return-from %f 15) 35))
46    (%f))
47  15)
48
49;;; The aux parameters are not in the block defined by
50;;; the local function declaration
51(deftest labels.6
52  (block %f
53    (labels ((%f (&aux (x (return-from %f 10)))
54               20))
55      (%f)
56      :bad))
57  10)
58
59;;; The function is visible inside itself
60(deftest labels.7
61  (labels ((%f (x n) (cond ((eql n 0) x)
62                           (t (%f (+ x n) (1- n))))))
63    (%f 0 10))
64  55)
65
66;;; Scope of defined function names includes &AUX parameters
67
68(deftest labels.7b
69  (labels ((%f (x &aux (b (%g x))) b)
70           (%g (y) (+ y y)))
71    (%f 10))
72  20)
73
74;;; Scope of defined function names includes &OPTIONAL parameters
75
76(deftest labels.7c
77  (labels ((%f (x &optional (b (%g x))) b)
78           (%g (y) (+ y y)))
79    (%f 10))
80  20)
81
82;;; Scope of defined function names includes &KEY parameters
83
84(deftest labels.7d
85  (labels ((%f (x &key (b (%g x))) b)
86           (%g (y) (+ y y)))
87    (%f 10))
88  20)
89
90;;; Keyword arguments
91(deftest labels.8
92  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
93    (%f))
94  nil 0 nil)
95
96(deftest labels.9
97  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
98    (%f :a 1))
99  1 0 nil)
100
101(deftest labels.10
102  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
103    (%f :b 2))
104  nil 2 t)
105
106(deftest labels.11
107  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
108    (%f :b 2 :a 3))
109  3 2 t)
110
111;;; Unknown keyword parameter should throw a program-error in safe code
112;;; (section 3.5.1.4)
113(deftest labels.12
114  (signals-error
115   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))
116   program-error)
117  t)
118
119;;; Odd # of keyword args should throw a program-error in safe code
120;;; (section 3.5.1.6)
121(deftest labels.13
122  (signals-error
123   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))
124   program-error)
125  t)
126
127;;; Too few arguments (section 3.5.1.2)
128(deftest labels.14
129  (signals-error (labels ((%f (a) a)) (%f))
130                 program-error)
131  t)
132
133;;; Too many arguments (section 3.5.1.3)
134(deftest labels.15
135  (signals-error (labels ((%f (a) a)) (%f 1 2))
136                 program-error)
137  t)
138
139;;; Invalid keyword argument (section 3.5.1.5)
140(deftest labels.16
141  (signals-error (labels ((%f (&key a) a)) (%f '(foo)))
142                 program-error)
143  t)
144
145;;; Definition of a (setf ...) function
146
147(deftest labels.17
148  (labels (((setf %f) (x y) (setf (car y) x)))
149    (let ((z (list 1 2)))
150      (setf (%f z) 'a)
151      z))
152  (a 2))
153
154;;; Body is an implicit progn
155(deftest labels.18
156  (labels ((%f (x) (incf x) (+ x x)))
157    (%f 10))
158  22)
159
160;;; Can handle at least 50 lambda parameters
161(deftest labels.19
162  (labels ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
163                b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
164                c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
165                d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
166                e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)
167               (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
168                  b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
169                  c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
170                  d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
171                  e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)))
172    (%f 1 2 3 4 5 6 7 8 9 10
173        11 12 13 14 15 16 17 18 19 20
174        21 22 23 24 25 26 27 28 29 30
175        31 32 33 34 35 36 37 38 39 40
176        41 42 43 44 45 46 47 48 49 50))
177  1275)
178
179;;; labels works with the maximum number of arguments (if
180;;; not too many.)
181(deftest labels.20
182  (let* ((n (min (1- lambda-parameters-limit) 1024))
183         (vars (loop repeat n collect (gensym))))
184    (eval
185     `(eqlt ,n
186            (labels ((%f ,vars (+ ,@ vars)))
187              (%f ,@(loop for e in vars collect 1))))))
188  t)
189
190;;; Declarations and documentation strings are ok
191(deftest labels.21
192  (labels ((%f (x)
193             (declare (type fixnum x))
194             "Add one to the fixnum x."
195             (1+ x)))
196    (declare (ftype (function (fixnum) integer) %f))
197    (%f 10))
198  11)
199
200;;; Keywords can be function names
201(deftest labels.22
202  (labels ((:foo () 10)
203           (:bar () (1+ (:foo))))
204    (:bar))
205  11)
206
207(deftest labels.23
208  (labels ((:foo () 10)
209           (:bar () (1+ (funcall #':foo))))
210    (funcall #':bar))
211  11)
212
213(deftest labels.24
214  (loop for s in *cl-non-function-macro-special-operator-symbols*
215        for form = `(ignore-errors (labels ((,s (x) (foo (1- x)))
216                                            (foo (y)
217                                                 (if (<= y 0) 'a
218                                                   (,s (1- y)))))
219                                     (,s 10)))
220        unless (eq (eval form) 'a)
221        collect s)
222  nil)
223
224(deftest labels.25
225  (loop for s in *cl-non-function-macro-special-operator-symbols*
226        for form = `(ignore-errors
227                     (labels ((,s (x) (foo (1- x)))
228                              (foo (y)
229                                   (if (<= y 0) 'a
230                                     (,s (1- y)))))
231                       (declare (ftype (function (integer) symbol)
232                                       foo ,s))
233                       (,s 10)))
234        unless (eq (eval form) 'a)
235        collect s)
236  nil)
237
238(deftest labels.26
239  (loop for s in *cl-non-function-macro-special-operator-symbols*
240        for form = `(ignore-errors
241                     (labels (((setf ,s) (&rest args)
242                               (declare (ignore args))
243                               'a))
244                       (setf (,s) 10)))
245        unless (eq (eval form) 'a)
246        collect s)
247  nil)
248
249;;; Check that LABELS does not have a tagbody
250(deftest labels.27
251  (block done
252    (tagbody
253     (labels ((%f () (go 10) 10 (return-from done 'bad)))
254       (%f))
255     10
256     (return-from done 'good)))
257  good)
258
259;;; Check that nil keyword arguments do not enable the default values
260
261(deftest labels.28
262  (labels ((%f (&key (a 'wrong)) a)) (%f :a nil))
263  nil)
264
265(deftest labels.29
266  (labels ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
267  (nil nil))
268
269(deftest labels.30
270  (labels ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
271  nil)
272
273(deftest labels.31
274  (labels ((%f (&key ((:a b) 'wrong present?)) (list b (not present?))))
275    (%f :a nil))
276  (nil nil))
277
278(deftest labels.32
279  (labels ((%f (&key) 'good))
280    (%f :allow-other-keys nil))
281  good)
282
283(deftest labels.33
284  (labels ((%f (&key) 'good))
285    (%f :allow-other-keys t))
286  good)
287
288(deftest labels.34
289  (labels ((%f (&key) 'good))
290    (%f :allow-other-keys t :a 1 :b 2))
291  good)
292
293(deftest labels.35
294  (labels ((%f (&key &allow-other-keys) 'good))
295    (%f :a 1 :b 2))
296  good)
297
298;;; NIL as a disallowed keyword argument
299(deftest labels.36
300  (signals-error
301   (labels ((%f (&key) :bad)) (%f nil nil))
302   program-error)
303  t)
304
305;;; Identity of function objects
306;;; Since (FUNCTION <name>) returns *the* functional value, it
307;;; should be the case that different invocations of this form
308;;; in the same lexical environment return the same value.
309
310(deftest labels.37
311  (labels ((f () 'foo))
312    (eqt #'f #'f))
313  t)
314
315(deftest labels.38
316  (labels ((f () 'foo))
317    (destructuring-bind (x y) (loop repeat 2 collect #'f) (eqlt x y)))
318  t)
319
320(deftest labels.39
321  (labels ((f () #'f))
322    (eqlt (f) #'f))
323  t)
324
325(deftest labels.40
326  (let ((x (labels ((f () #'f)) #'f)))
327    (eqlt x (funcall x)))
328  t)
329
330;;; Test that free declarations do not affect argument forms
331
332(deftest labels.41
333  (let ((x :bad))
334    (declare (special x))
335    (let ((x :good))
336      (labels ((%f (&optional (y x))
337                   (declare (special x))
338                   y))
339        (%f))))
340  :good)
341
342(deftest labels.42
343  (let ((x :bad))
344    (declare (special x))
345    (let ((x :good))
346      (labels ((%f (&key (y x))
347                   (declare (special x))
348                   y))
349        (%f))))
350  :good)
351
352(deftest labels.43
353  (let ((x :bad))
354    (declare (special x))
355    (let ((x :good))
356      (labels () (declare (special x)))
357      x))
358  :good)
359
360(deftest labels.44
361  (let ((x :bad))
362    (declare (special x))
363    (let ((x :good))
364      (labels ((%f () (declare (special x)))))
365      x))
366  :good)
367
368(deftest labels.45
369  (let ((x :bad))
370    (declare (special x))
371    (let ((x :good))
372      (labels ((%f () (declare (special x))))
373        x)))
374  :good)
375
376(deftest labels.46
377  (let ((x :bad))
378    (declare (special x))
379    (let ((x :good))
380      (labels ((%f (&aux (y x))
381                   (declare (special x))
382                   y))
383        (%f))))
384  :good)
385
386(deftest labels.47
387  (let ((x :bad))
388    (declare (special x))
389    (let ((x :good))
390      (labels ((%f () x))
391        (declare (special x))
392        (%f))))
393  :good)
394
395;;; Macros are expanded in the appropriate environment
396
397(deftest labels.48
398  (macrolet ((%m (z) z))
399            (labels () (expand-in-current-env (%m :good))))
400  :good)
401
402(deftest labels.49
403  (macrolet ((%m (z) z))
404            (labels ((%f () (expand-in-current-env (%m :good))))
405                    (%f)))
406  :good)
Note: See TracBrowser for help on using the repository browser.