1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sat Oct 12 09:24:36 2002 |
---|
4 | ;;;; Contains: Tests for LET, LET* |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | ;;; LET and LET* are also heavily exercised in the many other tests. |
---|
9 | |
---|
10 | ;;; NOTE! Some of these tests bind a variable with the same name |
---|
11 | ;;; more than once. This apparently has underdetermined semantics that |
---|
12 | ;;; varies in different Lisps. |
---|
13 | |
---|
14 | (deftest let.1 |
---|
15 | (let ((x 0)) x) |
---|
16 | 0) |
---|
17 | |
---|
18 | (deftest let.2 |
---|
19 | (let ((x 0) (y 1)) (values x y)) |
---|
20 | 0 1) |
---|
21 | |
---|
22 | (deftest let.3 |
---|
23 | (let ((x 0) (y 1)) (declare (special x y)) (values x y)) |
---|
24 | 0 1) |
---|
25 | |
---|
26 | (deftest let.4 |
---|
27 | (let ((x 0)) |
---|
28 | (let ((x 1)) |
---|
29 | x)) |
---|
30 | 1) |
---|
31 | |
---|
32 | (deftest let.5 |
---|
33 | (let ((x 0)) |
---|
34 | (let ((#:x 1)) |
---|
35 | x)) |
---|
36 | 0) |
---|
37 | |
---|
38 | (deftest let.6 |
---|
39 | (let ((x 0)) |
---|
40 | (declare (special x)) |
---|
41 | (let ((x 1)) |
---|
42 | (values x (locally (declare (special x)) x)))) |
---|
43 | 1 0) |
---|
44 | |
---|
45 | (deftest let.7 |
---|
46 | (let ((x '(a b c))) |
---|
47 | (declare (dynamic-extent x)) |
---|
48 | x) |
---|
49 | (a b c)) |
---|
50 | |
---|
51 | ;;;(deftest let.8 |
---|
52 | ;;; (let ((x 0) (x 1)) x) |
---|
53 | ;;; 1) |
---|
54 | |
---|
55 | (deftest let.9 |
---|
56 | (let (x y z) (values x y z)) |
---|
57 | nil nil nil) |
---|
58 | |
---|
59 | ;;; (deftest let.10 |
---|
60 | ;;; (let ((x 1) x) x) |
---|
61 | ;;; nil) |
---|
62 | |
---|
63 | (deftest let.11 |
---|
64 | (let ((x 1)) |
---|
65 | (list x |
---|
66 | (let (x) |
---|
67 | (declare (special x)) |
---|
68 | x) |
---|
69 | x)) |
---|
70 | (1 nil 1)) |
---|
71 | |
---|
72 | ;;; (deftest let.12 |
---|
73 | ;;; (let ((x 0)) |
---|
74 | ;;; (values |
---|
75 | ;;; (let ((x 20) |
---|
76 | ;;; (x (1+ x))) |
---|
77 | ;;; x) |
---|
78 | ;;; x)) |
---|
79 | ;;; 1 0) |
---|
80 | |
---|
81 | ;;; (deftest let.13 |
---|
82 | ;;; (flet ((%f () (declare (special x)) |
---|
83 | ;;; (if (boundp 'x) x 10))) |
---|
84 | ;;; (let ((x 1) |
---|
85 | ;;; (x (1+ (%f)))) |
---|
86 | ;;; (declare (special x)) |
---|
87 | ;;; x)) |
---|
88 | ;;; 11) |
---|
89 | |
---|
90 | ;;; Tests of large number of LET variables |
---|
91 | (deftest let.14 |
---|
92 | (let* ((n 100) |
---|
93 | (vars (mapcar #'gensym (make-list n :initial-element "G"))) |
---|
94 | (expr `(let ,(let ((i 0)) |
---|
95 | (mapcar #'(lambda (v) (list v (incf i))) vars)) |
---|
96 | ,(let ((sumexpr 0)) |
---|
97 | (dolist (v vars) |
---|
98 | (setq sumexpr `(+ ,v ,sumexpr))) |
---|
99 | sumexpr))) |
---|
100 | (val (eval expr))) |
---|
101 | (or (eqlt val (/ (* n (1+ n)) 2)) (list val))) |
---|
102 | t) |
---|
103 | |
---|
104 | ;;; Test that all non-variables exported from COMMON-LISP can be bound |
---|
105 | ;;; in LET forms. |
---|
106 | (deftest let.15 |
---|
107 | (loop for s in *cl-non-variable-constant-symbols* |
---|
108 | for form = `(ignore-errors (let ((,s 17)) ,s)) |
---|
109 | unless (eql (eval form) 17) |
---|
110 | collect s) |
---|
111 | nil) |
---|
112 | |
---|
113 | ;;; Check that LET does not have a tagbody |
---|
114 | (deftest let.16 |
---|
115 | (block done |
---|
116 | (tagbody |
---|
117 | (let () (go 10) 10 (return-from done 'bad)) |
---|
118 | 10 |
---|
119 | (return-from done 'good))) |
---|
120 | good) |
---|
121 | |
---|
122 | ;;; Check that free declarations do not apply to the init forms |
---|
123 | |
---|
124 | (deftest let.17 |
---|
125 | (let ((x :bad)) |
---|
126 | (declare (special x)) |
---|
127 | (let ((x :good)) ;; lexical binding |
---|
128 | (let ((y x)) |
---|
129 | (declare (special x)) ;; free declaration |
---|
130 | y))) |
---|
131 | :good) |
---|
132 | |
---|
133 | (deftest let.17a |
---|
134 | (funcall |
---|
135 | (compile |
---|
136 | nil |
---|
137 | '(lambda () |
---|
138 | (let ((x :bad)) |
---|
139 | (declare (special x)) |
---|
140 | (let ((x :good)) ;; lexical binding |
---|
141 | (let ((y x)) |
---|
142 | (declare (special x)) ;; free declaration |
---|
143 | y)))))) |
---|
144 | :good) |
---|
145 | |
---|
146 | (deftest let.18 |
---|
147 | (let ((foo 'special)) |
---|
148 | (declare (special foo)) |
---|
149 | (let ((foo 'lexical)) |
---|
150 | (locally (declare (special foo))) |
---|
151 | foo)) |
---|
152 | lexical) |
---|
153 | |
---|
154 | (deftest let.19 |
---|
155 | (loop for k in lambda-list-keywords |
---|
156 | unless (eql (eval `(let ((,k :foo)) ,k)) :foo) |
---|
157 | collect k) |
---|
158 | nil) |
---|
159 | |
---|
160 | ;;; Macros are expanded in the appropriate environment |
---|
161 | |
---|
162 | (deftest let.20 |
---|
163 | (macrolet ((%m (z) z)) |
---|
164 | (let () (expand-in-current-env (%m :good)))) |
---|
165 | :good) |
---|
166 | |
---|
167 | (deftest let.21 |
---|
168 | (macrolet ((%m (z) z)) |
---|
169 | (let ((x (expand-in-current-env (%m 1)))) (+ x x x))) |
---|
170 | 3) |
---|