source: trunk/source/tests/ansi-tests/let.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.3 KB
Line 
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)
Note: See TracBrowser for help on using the repository browser.