source: trunk/source/tests/ansi-tests/lambda.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: 7.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Nov 27 06:43:21 2002
4;;;; Contains: Tests of LAMBDA forms
5
6(in-package :cl-test)
7
8(deftest lambda.1
9  ((lambda (x) x) 'a)
10  a)
11
12(deftest lambda.2
13  ((lambda () 'a))
14  a)
15
16(deftest lambda.3
17  ((lambda () "documentation" 'a))
18  a)
19
20(deftest lambda.4
21  ((lambda (x) (declare (type symbol x)) x) 'z)
22  z)
23
24(deftest lambda.5
25  ((lambda (&aux (x 'a)) x))
26  a)
27
28(deftest lambda.6
29  ((lambda (&aux (x 'a)) (declare (type symbol x)) x))
30  a)
31
32(deftest lambda.7
33  ((lambda () "foo"))
34  "foo")
35
36(deftest lambda.8
37  ((lambda () "foo" "bar"))
38  "bar")
39
40(deftest lambda.9
41  ((lambda (x y) (declare (ignore x)) "foo" (declare (ignore y)) "bar") 1 2)
42  "bar")
43
44(deftest lambda.10
45  ((lambda (x) (declare (type symbol x) (ignorable x))) 'z)
46  nil)
47
48(deftest lambda.11
49  ((lambda (x &optional y z) (list x y z)) 1 2)
50  (1 2 nil))
51
52(deftest lambda.12
53  ((lambda (&optional (x 'a) (y 'b) (z 'c)) (list x y z)) 1 nil)
54  (1 nil c))
55
56(deftest lambda.13
57  ((lambda (&optional (x 'a x-p) (y 'b y-p) (z 'c z-p))
58     (list* x y z (mapcar #'notnot (list x-p y-p z-p)))) 1 nil)
59  (1 nil c t t nil))
60
61(deftest lambda.14
62  (let ((x 1))
63    ((lambda (&optional (x (1+ x))) x)))
64  2)
65
66(deftest lambda.15
67  ((lambda (y &optional (x (1+ y))) (list y x)) 10)
68  (10 11))
69
70(deftest lambda.16
71  ((lambda (y &optional (x (1+ y))) (list y x)) 10 14)
72  (10 14))
73
74(deftest lambda.17
75  ((lambda (&rest x) x) 1 2 3)
76  (1 2 3))
77
78(deftest lambda.18
79  (let ((b 10))
80    ((lambda (&optional (a b) (b (1+ a))) (list a b)) 3 7))
81  (3 7))
82
83(deftest lambda.19
84  (let ((b 10))
85    ((lambda (&optional (a b) (b (1+ a))) (list a b)) 3))
86  (3 4))
87
88(deftest lambda.20
89  (let ((b 10))
90    ((lambda (&optional (a b) (b (1+ a))) (list a b))))
91  (10 11))
92
93(deftest lambda.21
94  (flet ((%f () (locally (declare (special *x*)) (incf *x*))))
95    ((lambda (*x*)
96       (declare (special *x*))
97       (%f)
98       *x*)
99     10))
100  11)
101
102(deftest lambda.22
103  (flet ((%f () (locally (declare (special *x*)) (1+ *x*))))
104    ((lambda (*x*)
105       (declare (special *x*))
106       (%f))
107     15))
108  16)
109
110(deftest lambda.23
111  ((lambda (&key a) a))
112  nil)
113
114(deftest lambda.24
115  ((lambda (&key a b c) (list a b c)))
116  (nil nil nil))
117
118(deftest lambda.25
119  ((lambda (&key (a 1) (b 2) (c 3)) (list a b c)))
120  (1 2 3))
121
122(deftest lambda.26
123  ((lambda (&key)))
124  nil)
125
126(deftest lambda.27
127  ((lambda (&key) 'good) :allow-other-keys nil)
128  good)
129
130(deftest lambda.28
131  ((lambda (&key) 'good) :allow-other-keys t :foo t)
132  good)
133
134(deftest lambda.29
135  ((lambda (&key) 'good) :allow-other-keys t :allow-other-keys nil :foo t)
136  good)
137
138(deftest lambda.30
139  ((lambda (&key x) x) :allow-other-keys t :x 10
140   :allow-other-keys nil :foo t)
141  10)
142
143(deftest lambda.31
144  ((lambda (&rest x &key) x))
145  nil)
146
147(deftest lambda.32
148  ((lambda (&rest x &key) x) :allow-other-keys nil)
149  (:allow-other-keys nil))
150
151(deftest lambda.33
152  ((lambda (&rest x &key) x) :w 5 :allow-other-keys t :x 10)
153  (:w 5 :allow-other-keys t :x 10))
154
155(deftest lambda.34
156  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (notnot a-p)
157                                                      b (notnot b-p)
158                                                      c (notnot c-p)))
159   :c 5 :a 0)
160  (0 t 2 nil 5 t))
161
162(deftest lambda.35
163  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (notnot a-p)
164                                                      b (notnot b-p)
165                                                      c (notnot c-p)))
166   :c 5 :a nil :a 17 :c 100)
167  (nil t 2 nil 5 t))
168
169(deftest lambda.36
170  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (notnot a-p)
171                                                      b (notnot b-p)
172                                                      c (notnot c-p)))
173   :c 5 :a 0 :allow-other-keys t 'b 100)
174  (0 t 2 nil 5 t))
175
176(deftest lambda.37
177  (let ((b 1))
178    ((lambda (&key (a b) b) (list a b)) :b 'x))
179  (1 x))
180
181(deftest lambda.38
182  (let ((b 1))
183    ((lambda (&key (a b) b) (list a b)) :b 'x :a nil))
184  (nil x))
185
186(deftest lambda.39
187  (let ((a-p :bad))
188    (declare (ignorable a-p))
189    ((lambda (&key (a nil a-p) (b a-p)) (list a (notnot a-p) (notnot b)))))
190  (nil nil nil))
191     
192(deftest lambda.40
193  (let ((a-p :bad))
194    (declare (ignorable a-p))
195    ((lambda (&key (a nil a-p) (b a-p)) (list a (notnot a-p) (notnot b)))
196     :a 1))
197  (1 t t))
198
199(deftest lambda.41
200  (let ((a-p :bad))
201    (declare (ignorable a-p))
202    ((lambda (&key (a nil a-p) (b a-p)) (list a (notnot a-p) (notnot b)))
203     :a nil))
204  (nil t t))
205
206(deftest lambda.42
207  ((lambda (&key a b &allow-other-keys) (list a b)) :a 1 :b 2)
208  (1 2))
209
210(deftest lambda.43
211  ((lambda (&key a b &allow-other-keys) (list a b)) :b 2 :a 1)
212  (1 2))
213
214(deftest lambda.44
215  ((lambda (&key a b &allow-other-keys) (list a b)) :z 10 :b 2 :b nil :a 1
216   :a 2 'x 100)
217  (1 2))
218
219(deftest lambda.45
220  ((lambda (&key a b &allow-other-keys) (list a b)) :allow-other-keys nil
221   :z 10 :b 2 :b nil :a 1 :a 2 'x 100)
222  (1 2))
223
224(deftest lambda.46
225  ((lambda (&key a b allow-other-keys) (list allow-other-keys a b))
226   :allow-other-keys nil :a 1 :b 2)
227  (nil 1 2))
228
229(deftest lambda.47
230  ((lambda (&key a b allow-other-keys) (list allow-other-keys a b))
231   :c 10 :allow-other-keys t :a 1 :b 2 :d 20)
232  (t 1 2))
233
234(deftest lambda.48
235  ((lambda (&key a b allow-other-keys &allow-other-keys)
236     (list allow-other-keys a b))
237   :d 40 :allow-other-keys nil :a 1 :b 2 :c 20)
238  (nil 1 2))
239
240(deftest lambda.49
241  ((lambda (&key a b allow-other-keys &allow-other-keys)
242     (list allow-other-keys a b))
243   :d 40 :a 1 :b 2 :c 20)
244  (nil 1 2))
245
246(deftest lambda.50
247  ((lambda (&key a b ((:allow-other-keys aok)))
248     (list aok a b))
249   :d 40 :a 1 :allow-other-keys t :b 2 :c 20)
250  (t 1 2))
251
252(deftest lambda.51
253  ((lambda (&key &allow-other-keys)) :a 1 :b 2 :c 3)
254  nil)
255
256;;; Free declaration scope
257
258(deftest lambda.52
259  (let ((x :bad))
260    (declare (special x))
261    (let ((x :good))
262      ((lambda (&optional (y x)) (declare (special x)) y))))
263  :good)
264
265(deftest lambda.53
266  (let ((x :bad))
267    (declare (special x))
268    (let ((x :good))
269      ((lambda (&key (y x)) (declare (special x)) y))))
270  :good)
271
272(deftest lambda.54
273  (let ((x :bad))
274    (declare (special x))
275    (let ((x :good))
276      ((lambda (&aux (y x)) (declare (special x)) y))))
277  :good)
278
279(deftest lambda.55
280  (let* ((doc "LMB55")
281         (fn (eval `#'(lambda () ,doc nil)))
282         (cfn (compile nil fn)))
283    (values
284     (or (documentation fn t) doc)
285     (or (documentation cfn t) doc)))
286  "LMB55"
287  "LMB55")
288
289(deftest lambda.56
290  (let* ((doc "LMB56")
291         (fn (eval `#'(lambda () ,doc nil)))
292         (cfn (compile nil fn)))
293    (values
294     (or (documentation fn 'function) doc)
295     (or (documentation cfn 'function) doc)))
296  "LMB56"
297  "LMB56")
298
299;;; Uninterned symbols as lambda variables
300
301(deftest lambda.57
302  ((lambda (#1=#:foo) #1#) 17)
303  17)
304
305(deftest lambda.58
306  ((lambda (&rest #1=#:foo) #1#) 'a 'b 'c)
307  (a b c))
308
309(deftest lambda.59
310  ((lambda (&optional #1=#:foo) #1#))
311  nil)
312
313(deftest lambda.60
314  ((lambda (&optional (#1=#:foo t)) #1#))
315  t)
316
317(deftest lambda.61
318  ((lambda (&optional (#1=#:foo t)) #1#) 'bar)
319  bar)
320
321(deftest lambda.62
322  ((lambda (&key #1=#:foo) #1#) :foo 12)
323  12)
324
325;;; Test that declarations for aux variables are handled properly
326
327(deftest lambda.63
328  (let ((y :bad1))
329    (declare (ignore y))
330    (let ((y :bad2))
331      (declare (special y))
332      (flet ((%f () y))
333        ((lambda (x &aux (y :good))
334           (declare (special y) (ignore x))
335           (%f))
336         nil))))
337  :good)
338
339(deftest lambda.64
340  (let ((x :bad))
341    (declare (special x))
342    (flet ((%f () x))
343      ((lambda (x &aux (y (%f)))
344         (declare (type t y) (special x))
345         y)
346       :good)))
347  :good)
348
349;;; Tests of lambda as a macro
350
351(deftest lambda.macro.1
352  (notnot (macro-function 'lambda))
353  t)
354
355(deftest lambda.macro.2
356  (funcall (eval (macroexpand '(lambda () 10))))
357  10)
358
359;;; Error tests
360
361(deftest lambda.error.1
362  (signals-error (funcall (macro-function 'lambda))
363                 program-error)
364  t)
365
366(deftest lambda.error.2
367  (signals-error (funcall (macro-function 'lambda) '(lambda ()))
368                 program-error)
369  t)
370
371(deftest lambda.error.3
372  (signals-error (funcall (macro-function 'lambda) '(lambda ()) nil nil)
373                 program-error)
374  t)
Note: See TracBrowser for help on using the repository browser.