source: trunk/source/tests/ansi-tests/tagbody.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: 2.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct 12 13:27:22 2002
4;;;; Contains: Tests of TAGBODY
5
6(in-package :cl-test)
7
8(deftest tagbody.1
9  (tagbody)
10  nil)
11
12(deftest tagbody.2
13  (tagbody 'a)
14  nil)
15
16(deftest tagbody.3
17  (tagbody (values))
18  nil)
19
20(deftest tagbody.4
21  (tagbody (values 1 2 3 4 5))
22  nil)
23
24(deftest tagbody.5
25  (let ((x 0))
26    (values
27     (tagbody
28      (setq x 1)
29      (go a)
30      (setq x 2)
31      a)
32     x))
33  nil 1)
34
35(deftest tagbody.6
36  (let ((x 0))
37    (tagbody
38     (setq x 1)
39     (go a)
40     b
41     (setq x 2)
42     (go c)
43     a
44     (setq x 3)
45     (go b)
46     c)
47    x)
48  2)
49
50;;; Macroexpansion occurs after tag determination
51(deftest tagbody.7
52  (let ((x 0))
53    (macrolet ((%m () 'a))
54      (tagbody
55       (tagbody
56        (go a)
57        (%m)
58        (setq x 1))
59       a ))
60    x)
61  0)
62
63(deftest tagbody.8
64  (let ((x 0))
65    (tagbody
66     (flet ((%f (y) (setq x y) (go a)))
67       (%f 10))
68     (setq x 1)
69     a)
70    x)
71  10)
72
73;;; Tag names are in their own name space
74(deftest tagbody.9
75  (let (result)
76    (tagbody
77     (flet ((a (x) x))
78       (setq result (a 10))
79       (go a))
80     a)
81    result)
82  10)
83
84(deftest tagbody.10
85  (let (result)
86    (tagbody
87     (block a
88       (setq result 10)
89       (go a))
90     (setq result 20)
91     a)
92    result)
93  10)
94
95(deftest tagbody.11
96  (let (result)
97    (tagbody
98     (catch 'a
99       (setq result 10)
100       (go a))
101     (setq result 20)
102     a)
103    result)
104  10)
105
106(deftest tagbody.12
107  (let (result)
108    (tagbody
109     (block a
110       (setq result 10)
111       (return-from a nil))
112     (setq result 20)
113     a)
114    result)
115  20)
116
117;;; Test that integers are accepted as go tags
118
119(deftest tagbody.13
120  (block done
121    (tagbody
122     (go around)
123     10
124     (return-from done 'good)
125     around
126     (go 10)))
127  good)
128
129(deftest tagbody.14
130  (block done
131    (tagbody
132     (go around)
133     -10
134     (return-from done 'good)
135     around
136     (go -10)))
137  good)
138
139(deftest tagbody.15
140  (block done
141    (tagbody
142     (go around)
143     #.(1+ most-positive-fixnum)
144     (return-from done 'good)
145     around
146     (go #.(1+ most-positive-fixnum))))
147  good)
148
149(deftest tagbody.16
150  (let* ((t1 (1+ most-positive-fixnum))
151         (t2 (1+ most-positive-fixnum))
152         (form `(block done
153                  (tagbody
154                   (go around)
155                   ,t1
156                   (return-from done 'good)
157                   around
158                   (go ,t2)))))
159    (eval form))
160  good)
161
162;;; Check that macros are not expanded before finding tags
163;;; Test for issue TAGBODY-TAG-EXPANSION
164
165(deftest tagbody.17
166  (block done
167    (tagbody
168     (macrolet ((foo () 'tag))
169       (let (tag)
170         (tagbody
171          (go tag)
172          (foo)
173          (return-from done :bad))))
174     tag
175     (return-from done :good)))
176  :good)
177
178;;; Test that explicit calls to macroexpand in subforms
179;;; are done in the correct environment
180
181(deftest tagbody.18
182  (macrolet ((%m (z) z))
183    (tagbody
184      (expand-in-current-env (%m :foo))))
185  nil)
Note: See TracBrowser for help on using the repository browser.