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