source: trunk/source/tests/ansi-tests/prog.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 19 09:21:57 2002
4;;;; Contains: Tests of PROG
5
6(in-package :cl-test)
7
8(deftest prog.1
9  (prog ())
10  nil)
11
12(deftest prog.2
13  (prog () 'a)
14  nil)
15
16(deftest prog.3
17  (prog () (return 'a))
18  a)
19
20(deftest prog.4
21  (prog () (return (values 1 2 3 4 5)))
22  1 2 3 4 5)
23
24(deftest prog.5
25  (let ((x 'a))
26    (prog ((x 'b) (y x))
27          (declare (type symbol x y))
28          (return (values x y))))
29  b a)
30
31(deftest prog.6
32  (let ((x 'a))
33    (prog (x) (setq x 'b))
34    x)
35  a)
36
37(deftest prog.7
38  (prog ((i 1) (s 0))
39        (declare (type fixnum i s))
40        again
41        (when (> i 10) (return s))
42        (incf s i)
43        (incf i)
44        (go again))
45  55)
46
47(deftest prog.8
48  (let ((x 0))
49    (prog ((y (incf x)) (z (incf x)))
50          (return (values x y z))))
51  2 1 2)
52
53(deftest prog.9
54  (flet ((%f () (locally (declare (special z)) z)))
55    (prog ((z 10))
56          (declare (special z))
57          (return (%f))))
58  10)
59
60(deftest prog.10
61  (prog ()
62        (return
63         (1+
64          (prog ()
65                (go end)
66                done
67                (return 1)
68                end
69                (go done))))
70        done
71        (return 'bad))
72  2)
73
74(deftest prog.11
75  (let ((x :bad))
76    (declare (special x))
77    (let ((x :good))
78      (prog ((y x))
79            (declare (special x))
80            (return y))))
81  :good)
82
83;;; Test that explicit calls to macroexpand in subforms
84;;; are done in the correct environment
85
86(deftest prog.12
87  (macrolet
88   ((%m (z) z))
89   (prog ((x (expand-in-current-env (%m :good)))) (return x)))
90  :good)
91
92(def-macro-test prog.error.1 (prog nil))
93
94;;; Tests of PROG*
95
96(deftest prog*.1
97  (prog* ())
98  nil)
99
100(deftest prog*.2
101  (prog* () 'a)
102  nil)
103
104(deftest prog*.3
105  (prog* () (return 'a))
106  a)
107
108(deftest prog*.4
109  (prog* () (return (values 1 2 3 4 5)))
110  1 2 3 4 5)
111
112(deftest prog*.5
113  (let ((x 'a))
114    (prog* ((z x) (x 'b) (y x))
115          (declare (type symbol x y))
116          (return (values x y z))))
117  b b a)
118
119(deftest prog*.6
120  (let ((x 'a))
121    (prog* (x) (setq x 'b))
122    x)
123  a)
124
125(deftest prog*.7
126  (prog* ((i 1) (s 0))
127        (declare (type fixnum i s))
128        again
129        (when (> i 10) (return s))
130        (incf s i)
131        (incf i)
132        (go again))
133  55)
134
135(deftest prog*.8
136  (let ((x 0))
137    (prog* ((y (incf x)) (z (incf x)))
138          (return (values x y z))))
139  2 1 2)
140
141(deftest prog*.9
142  (flet ((%f () (locally (declare (special z)) z)))
143    (prog* ((z 10))
144          (declare (special z))
145          (return (%f))))
146  10)
147
148(deftest prog*.10
149  (prog* ()
150        (return
151         (1+
152          (prog* ()
153                (go end)
154                done
155                (return 1)
156                end
157                (go done))))
158        done
159        (return 'bad))
160  2)
161
162(deftest prog*.11
163  (let ((x :bad))
164    (declare (special x))
165    (let ((x :good))
166      (prog* ((y x))
167             (declare (special x))
168             (return y))))
169  :good)
170
171;;; Test that explicit calls to macroexpand in subforms
172;;; are done in the correct environment
173
174(deftest prog*.12
175  (macrolet
176   ((%m (z) z))
177   (prog* ((x (expand-in-current-env (%m :good)))) (return x)))
178  :good)
179
180(def-macro-test prog*.error.1 (prog* nil))
Note: See TracBrowser for help on using the repository browser.