source: trunk/source/tests/ansi-tests/flet.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: 13.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Oct  8 22:55:02 2002
4;;;; Contains: Tests of FLET
5
6(in-package :cl-test)
7
8(deftest flet.1
9  (flet ((%f () 1))
10    (%f))
11  1)
12
13(deftest flet.2
14  (flet ((%f (x) x))
15    (%f 2))
16  2)
17
18(deftest flet.3
19  (flet ((%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 flet.4
26  (block %f
27    (flet ((%f (&optional (x (return-from %f :good)))
28               nil))
29      (%f)
30      :bad))
31  :good)
32
33;;; Key arguments are not in the block defined by
34;;; the local function declaration
35(deftest flet.4a
36  (block %f
37    (flet ((%f (&key (x (return-from %f :good)))
38               nil))
39      (%f)
40      :bad))
41  :good)
42
43(deftest flet.5
44  (flet ((%f () (return-from %f 15) 35))
45    (%f))
46  15)
47
48;;; The aux parameters are not in the block defined by
49;;; the local function declaration
50(deftest flet.6
51  (block %f
52    (flet ((%f (&aux (x (return-from %f 10)))
53               20))
54      (%f)))
55  10)
56
57;;; The function is not visible inside itself
58(deftest flet.7
59  (flet ((%f (x) (+ x 5)))
60    (flet ((%f (y) (cond ((eql y 20) 30)
61                         (t (%f 20)))))
62      (%f 15)))
63  25)
64
65;;; Keyword arguments
66(deftest flet.8
67  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
68    (%f))
69  nil 0 nil)
70
71(deftest flet.9
72  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
73    (%f :a 1))
74  1 0 nil)
75
76(deftest flet.10
77  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
78    (%f :b 2))
79  nil 2 t)
80
81(deftest flet.11
82  (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
83    (%f :b 2 :a 3))
84  3 2 t)
85
86;;; Unknown keyword parameter should throw a program-error in safe code
87;;; (section 3.5.1.4)
88(deftest flet.12
89  (signals-error
90   (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))
91   program-error)
92  t)
93
94;;; Odd # of keyword args should throw a program-error in safe code
95;;; (section 3.5.1.6)
96(deftest flet.13
97  (signals-error
98   (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))
99   program-error)
100  t)
101
102;;; Too few arguments (section 3.5.1.2)
103(deftest flet.14
104  (signals-error (flet ((%f (a) a)) (%f)) program-error)
105  t)
106
107;;; Too many arguments (section 3.5.1.3)
108(deftest flet.15
109  (signals-error (flet ((%f (a) a)) (%f 1 2)) program-error)
110  t)
111
112;;; Invalid keyword argument (section 3.5.1.5)
113(deftest flet.16
114  (signals-error (flet ((%f (&key a) a)) (%f '(foo))) program-error)
115  t)
116
117
118;;; Definition of a (setf ...) function
119
120(deftest flet.17
121  (flet (((setf %f) (x y) (setf (car y) x)))
122    (let ((z (list 1 2)))
123      (setf (%f z) 'a)
124      z))
125  (a 2))
126
127;;; Body is an implicit progn
128(deftest flet.18
129  (flet ((%f (x) (incf x) (+ x x)))
130    (%f 10))
131  22)
132
133;;; Can handle at least 50 lambda parameters
134(deftest flet.19
135  (flet ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
136              b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
137              c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
138              d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
139              e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)
140             (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
141                b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
142                c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
143                d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
144                e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)))
145    (%f 1 2 3 4 5 6 7 8 9 10
146        11 12 13 14 15 16 17 18 19 20
147        21 22 23 24 25 26 27 28 29 30
148        31 32 33 34 35 36 37 38 39 40
149        41 42 43 44 45 46 47 48 49 50))
150  1275)
151
152;;; flet works with a large (maximal?) number of arguments
153(deftest flet.20
154  (let* ((n (min (1- lambda-parameters-limit) 1024))
155         (vars (loop repeat n collect (gensym))))
156    (eval
157     `(eqlt ,n
158            (flet ((%f ,vars (+ ,@ vars)))
159              (%f ,@(loop for e in vars collect 1))))))
160  t)
161
162;;; Declarations and documentation strings are ok
163(deftest flet.21
164  (flet ((%f (x)
165             (declare (type fixnum x))
166             "Add one to the fixnum x."
167             (1+ x)))
168    (declare (ftype (function (fixnum) integer) %f))
169    (%f 10))
170  11)
171
172(deftest flet.22
173  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p))
174             (list x y (not (not y-p)) z (not (not z-p)))))
175    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)))
176  (10 1 nil 2 nil)
177  (20 40 t 2 nil)
178  (a b t c t))
179
180(deftest flet.23
181  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r)
182             (list x y (not (not y-p)) z (not (not z-p)) r)))
183    (values (%f 10) (%f 20 40) (%f 'a 'b 'c) (%f 'd 'e 'f 'g 'h)))
184  (10 1 nil 2 nil nil)
185  (20 40 t 2 nil nil)
186  (a b t c t nil)
187  (d e t f t (g h)))
188
189(deftest flet.24
190  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar)
191             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
192    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
193            (%f 'd 'e 'f :foo 'h)
194            (%f 'd 'e 'f :bar 'i) ))
195  (10 1 nil 2 nil nil nil nil)
196  (20 40 t 2 nil nil nil nil)
197  (a b t c t nil nil nil)
198  (d e t f t (:foo h) h nil)
199  (d e t f t (:bar i) nil i))
200
201(deftest flet.25
202  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar
203                &allow-other-keys)
204             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
205    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
206            (%f 'd 'e 'f :foo 'h :whatever nil)
207            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z) ))
208  (10 1 nil 2 nil nil nil nil)
209  (20 40 t 2 nil nil nil nil)
210  (a b t c t nil nil nil)
211  (d e t f t (:foo h :whatever nil) h nil)
212  (d e t f t (:bar i :illegal t :foo z) z i))
213
214(deftest flet.26
215  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar)
216             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
217    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
218            (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys t)
219            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z :allow-other-keys t) ))
220  (10 1 nil 2 nil nil nil nil)
221  (20 40 t 2 nil nil nil nil)
222  (a b t c t nil nil nil)
223  (d e t f t (:foo h :whatever nil :allow-other-keys t) h nil)
224  (d e t f t (:bar i :illegal t :foo z :allow-other-keys t) z i))
225
226;;; Section 3.4.1.4.1: "The :allow-other-keys argument is permissible
227;;; in all situations involving keyword[2] arguments, even when its
228;;; associated value is false."
229(deftest flet.27
230  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r &key foo bar)
231             (list x y (not (not y-p)) z (not (not z-p)) r foo bar)))
232    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
233            (%f 'd 'e 'f :foo 'h :allow-other-keys nil)
234            (%f 'd 'e 'f :bar 'i :allow-other-keys nil) ))
235  (10 1 nil 2 nil nil nil nil)
236  (20 40 t 2 nil nil nil nil)
237  (a b t c t nil nil nil)
238  (d e t f t (:foo h :allow-other-keys nil) h nil)
239  (d e t f t (:bar i :allow-other-keys nil) nil i))
240
241(deftest flet.28
242  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r
243                &key foo bar allow-other-keys)
244             (list x y (not (not y-p)) z (not (not z-p)) allow-other-keys
245                   r foo bar)))
246    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
247            (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys 100)
248            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z :allow-other-keys 200) ))
249  (10 1 nil 2 nil nil nil nil nil)
250  (20 40 t 2 nil nil nil nil nil)
251  (a b t c t nil nil nil nil)
252  (d e t f t 100 (:foo h :whatever nil :allow-other-keys 100) h nil)
253  (d e t f t 200 (:bar i :illegal t :foo z :allow-other-keys 200) z i))
254
255(deftest flet.29
256  (flet ((%f (x &optional (y 1 y-p) (z 2 z-p) &rest r
257                &key foo bar allow-other-keys &allow-other-keys)
258             (list x y (not (not y-p)) z (not (not z-p)) allow-other-keys
259                   r foo bar)))
260    (values (%f 10) (%f 20 40) (%f 'a 'b 'c)
261            (%f 'd 'e 'f :foo 'h :whatever nil :allow-other-keys nil :blah t)
262            (%f 'd 'e 'f :bar 'i :illegal t :foo 'z
263                :allow-other-keys nil :zzz 10) ))
264  (10 1 nil 2 nil nil nil nil nil)
265  (20 40 t 2 nil nil nil nil nil)
266  (a b t c t nil nil nil nil)
267  (d e t f t nil (:foo h :whatever nil :allow-other-keys nil :blah t) h nil)
268  (d e t f t nil (:bar i :illegal t :foo z :allow-other-keys nil :zzz 10) z i))
269
270;;; Tests of non-keyword keywords (see section 3.4.1.4, paragrph 2).
271(deftest flet.30
272  (flet ((%f (&key ((foo bar) nil)) bar))
273    (values (%f) (%f 'foo 10)))
274  nil 10)
275
276(deftest flet.31
277  (flet ((%f (&key ((:foo bar) nil)) bar))
278    (values (%f) (%f :foo 10)))
279  nil 10)
280
281;;; Multiple keyword actual parameters
282(deftest flet.32
283  (flet ((%f (&key a b c) (list a b c)))
284    (%f :a 10 :b 20 :c 30 :a 40 :b 50 :c 60))
285  (10 20 30))
286   
287;;; More aux parameters
288(deftest flet.33
289  (flet ((%f (x y &aux (a (1+ x)) (b (+ x y a)) (c (list x y a b)))
290             c))
291    (%f 5 9))
292  (5 9 6 20))
293
294(deftest flet.34
295  (flet ((%f (x y &rest r &key foo bar &aux (c (list x y r foo bar)))
296             c))
297    (values
298     (%f 1 2)
299     (%f 1 2 :foo 'a)
300     (%f 1 2 :bar 'b)
301     (%f 1 2 :foo 'a :bar 'b)
302     (%f 1 2 :bar 'b :foo 'a)))
303  (1 2 nil nil nil)
304  (1 2 (:foo a) a nil)
305  (1 2 (:bar b) nil b)
306  (1 2 (:foo a :bar b) a b)
307  (1 2 (:bar b :foo a) a b))
308
309;;; Binding of formal parameters that are also special variables
310(deftest flet.35
311  (let ((x 'bad))
312    (declare (special x))
313    (flet ((%f () x))
314      (flet ((%g (x)
315                 (declare (special x))
316                 (%f)))
317        (%g 'good))))
318  good)
319
320(deftest flet.36
321  (let ((x 'bad))
322    (declare (special x))
323    (flet ((%f () x))
324      (flet ((%g (&aux (x 'good))
325                 (declare (special x))
326                 (%f)))
327         (%g))))
328  good)
329
330(deftest flet.37
331  (let ((x 'bad))
332    (declare (special x))
333    (flet ((%f () x))
334      (flet ((%g (&rest x)
335                 (declare (special x))
336                 (%f)))
337         (%g 'good))))
338  (good))
339
340(deftest flet.38
341  (let ((x 'bad))
342    (declare (special x))
343    (flet ((%f () x))
344      (flet ((%g (&key (x 'good))
345                 (declare (special x))
346                 (%f)))
347         (%g))))
348  good)
349
350(deftest flet.39
351  (let ((x 'bad))
352    (declare (special x))
353    (flet ((%f () x))
354      (flet ((%g (&key (x 'bad))
355                 (declare (special x))
356                 (%f)))
357         (%g :x 'good))))
358  good)
359
360(deftest flet.40
361  (let ((x 'good))
362    (declare (special x))
363    (flet ((%f () x))
364      (flet ((%g (&key (x 'bad))
365                 (%f)))
366         (%g :x 'worse))))
367  good)
368
369
370(deftest flet.45
371  (flet ((nil () 'a)) (nil))
372  a)
373
374(deftest flet.46
375  (flet ((t () 'b)) (t))
376  b)
377
378;;; Keywords can be function names
379(deftest flet.47
380  (flet ((:foo () 'bar)) (:foo))
381  bar)
382
383(deftest flet.48
384  (flet ((:foo () 'bar)) (funcall #':foo))
385  bar)
386
387(deftest flet.49
388  (loop for s in *cl-non-function-macro-special-operator-symbols*
389        for form = `(ignore-errors (flet ((,s () 'a)) (,s)))
390        unless (eq (eval form) 'a)
391        collect s)
392  nil)
393
394(deftest flet.50
395  (loop for s in *cl-non-function-macro-special-operator-symbols*
396        for form = `(ignore-errors (flet ((,s () 'a))
397                                      (declare (ftype (function () symbol)
398                                                      ,s))
399                                      (,s)))
400        unless (eq (eval form) 'a)
401        collect s)
402  nil)
403
404;;; Binding SETF functions of certain COMMON-LISP symbols
405(deftest flet.51
406  (loop for s in *cl-non-function-macro-special-operator-symbols*
407        for form = `(ignore-errors
408                     (flet (((setf ,s) (&rest args)
409                             (declare (ignore args))
410                             'a))
411                       (setf (,s) 10)))
412        unless (eq (eval form) 'a)
413        collect s)
414  nil)
415
416;;; Check that FLET does not have a tagbody
417(deftest flet.52
418  (block done
419    (tagbody
420     (flet ((%f () (go 10) 10 (return-from done 'bad)))
421       (%f))
422     10
423     (return-from done 'good)))
424  good)
425
426;;; Check that nil keyword arguments do not enable the default values
427
428(deftest flet.53
429  (flet ((%f (&key (a 'wrong)) a)) (%f :a nil))
430  nil)
431
432(deftest flet.54
433  (flet ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
434  (nil nil))
435
436(deftest flet.55
437  (flet ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
438  nil)
439
440(deftest flet.56
441  (flet ((%f (&key ((:a b) 'wrong present?)) (list b (not present?)))) (%f :a nil))
442  (nil nil))
443
444(deftest flet.57
445  (flet ((%f (&key) 'good))
446    (%f :allow-other-keys nil))
447  good)
448
449(deftest flet.58
450  (flet ((%f (&key) 'good))
451    (%f :allow-other-keys t))
452  good)
453
454(deftest flet.59
455  (flet ((%f (&key) 'good))
456    (%f :allow-other-keys t :a 1 :b 2))
457  good)
458
459(deftest flet.60
460  (flet ((%f (&key &allow-other-keys) 'good))
461    (%f :a 1 :b 2))
462  good)
463
464;;; NIL as a disallowed keyword argument
465(deftest flet.61
466  (signals-error
467   (flet ((%f (&key) :bad)) (%f nil nil))
468   program-error)
469  t)
470
471;;; Free declarations do not affect argument forms
472
473(deftest flet.62
474  (let ((x :bad))
475    (declare (special x))
476    (let ((x :good))
477      (flet ((%f (&optional (y x))
478                 (declare (special x))
479                 y))
480        (%f))))
481  :good)
482
483(deftest flet.63
484  (let ((x :bad))
485    (declare (special x))
486    (let ((x :good))
487      (flet ((%f (&key (y x))
488                 (declare (special x))
489                 y))
490        (%f))))
491  :good)
492
493(deftest flet.64
494  (let ((x :bad))
495    (declare (special x))
496    (let ((x :good))
497      (flet () (declare (special x)))
498      x))
499  :good)
500
501(deftest flet.65
502  (let ((x :bad))
503    (declare (special x))
504    (let ((x :good))
505      (flet ((%f () (declare (special x)))))
506      x))
507  :good)
508
509(deftest flet.66
510  (let ((x :bad))
511    (declare (special x))
512    (let ((x :good))
513      (flet ((%f () (declare (special x))))
514        x)))
515  :good)
516
517(deftest flet.67
518  (let ((x :bad))
519    (declare (special x))
520    (let ((x :good))
521      (flet ((%f (&aux (y x))
522                 (declare (special x))
523                 y))
524        (%f))))
525  :good)
526
527(deftest flet.68
528  (let ((x :bad))
529    (declare (special x))
530    (let ((x :good))
531      (flet ((%f () x))
532        (declare (special x))
533        (%f))))
534  :good)
535
536(deftest flet.69
537  (let ((*x* 0))
538    (declare (special *x*))
539    (flet ((%f (i)
540               #'(lambda (arg)
541                   (declare (ignore arg))
542                   (incf *x* i))))
543      (values
544       (mapcar (%f 1) '(a b c))
545       (mapcar (%f 2) '(a b c)))))
546  (1 2 3)
547  (5 7 9))
548
549;;; Macros are expanded in the appropriate environment
550
551(deftest flet.70
552  (macrolet ((%m (z) z))
553            (flet () (expand-in-current-env (%m :good))))
554  :good)
555
556(deftest flet.71
557  (macrolet ((%m (z) z))
558            (flet ((%f () (expand-in-current-env (%m :good))))
559                  (%f)))
560  :good)
561
562
Note: See TracBrowser for help on using the repository browser.