source: trunk/source/tests/ansi-tests/beyond-ansi/errors-data-and-control-flow-2.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: 9.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue May 31 08:08:49 2005
4;;;; Contains: Tests of non-ANSI exceptional situations from CLHS section 5, part 2
5
6(in-package :ba-test)
7
8(compile-and-load "ba-aux.lsp")
9
10;;; FUNCALL
11
12(def-all-error-test funcall.1 'function-designator-p '(funcall x))
13(def-error-test funcall.2 (funcall cons 1 . 2))
14
15;;; FUNCTION
16
17(def-error-test function.1 (function))
18(def-error-test function.2 (function . cons))
19(def-error-test function.3 (function cons . foo))
20(def-error-test function.4 (function cons nil))
21(def-all-error-test function.5 'function-name-p '(function x))
22(def-all-error-test function.6
23  (constantly nil) #'(lambda (x) `(function ,x))
24  :vals cl-test::*cl-macro-symbols*)
25(def-all-error-test function.7
26  (constantly nil) #'(lambda (x) `(function ,x))
27  :vals cl-test::*cl-special-operator-symbols*)
28(def-error-test function.8 (macrolet ((%m () nil)) #'%m))
29
30;;; FUNCTION-LAMBDA-EXPRESSION
31
32(def-all-error-test function-lambda-expression.1
33  'functionp '(function-lambda-expression x))
34
35;;; DEFCONSTANT
36
37(def-error-test defconstant.1 (defconstant))
38(def-error-test defconstant.2 (defconstant . foo))
39(def-error-test defconstant.3 (defconstant #.(gensym)))
40(def-error-test defconstant.4 (defconstant #.(gensym) . foo))
41(def-error-test defconstant.5 (defconstant #.(gensym) nil . foo))
42(def-error-test defconstant.6 (defconstant #.(gensym) nil "foo" . bar))
43
44(def-all-error-test defconstant.7 'symbolp
45  #'(lambda (x) `(defconstant ,x nil)))
46
47(def-all-error-test defconstant.8 'stringp
48  #'(lambda (x) `(defconstant ,(gensym) nil ,x)))
49
50;;; DEFPARAMETER
51
52(def-error-test defparameter.1 (defparameter))
53(def-error-test defparameter.2 (defparameter . foo))
54(def-error-test defparameter.3 (defparameter #.(gensym)))
55(def-error-test defparameter.4 (defparameter #.(gensym) . foo))
56(def-error-test defparameter.5 (defparameter #.(gensym) nil . foo))
57(def-error-test defparameter.6 (defparameter #.(gensym) nil "foo" . bar))
58
59(def-all-error-test defparameter.7 'symbolp
60  #'(lambda (x) `(defparameter ,x nil)))
61
62(def-all-error-test defparameter.8 'stringp
63  #'(lambda (x) `(defparameter ,(gensym) nil ,x)))
64
65;;; DEFVAR
66
67(def-error-test defvar.1 (defvar))
68(def-error-test defvar.2 (defvar . foo))
69(def-error-test defvar.4 (defvar #.(gensym) . foo))
70(def-error-test defvar.5 (defvar #.(gensym) nil . foo))
71(def-error-test defvar.6 (defvar #.(gensym) nil "foo" . bar))
72
73(def-all-error-test defvar.7 'symbolp
74  #'(lambda (x) `(defvar ,x nil)))
75
76(def-all-error-test defvar.8 'stringp
77  #'(lambda (x) `(defvar ,(gensym) nil ,x)))
78
79;;; DESTRUCTURING-BIND
80
81(def-error-test destructuring-bind.1 (destructuring-bind))
82(def-error-test destructuring-bind.2 (destructuring-bind x))
83(def-all-error-test destructuring-bind.3
84  (typef '(or symbol cons))
85  #'(lambda (x) `(destructuring-bind ,x nil)))
86(def-error-test destructuring-bind.4 (destructuring-bind (x) '(a) nil (declare) x))
87
88;;; LET
89
90(def-error-test let.1 (let))
91(def-error-test let.2 (let . x))
92(def-all-error-test let.3 'listp #'(lambda (x) `(let ,x nil)))
93(def-error-test let.4 (let () . x))
94(def-error-test let.5 (let (x . 1) nil))
95(def-error-test let.6 (let ((x) . y) nil))
96(def-error-test let.7 (let ((x 1 . 2)) nil))
97(def-error-test let.8 (let ((x 1 2)) nil))
98(def-error-test let.9 (let ((x 1) (x 2)) x))
99(def-error-test let.10 (let ((t 1)) t))
100(def-all-error-test let.11 (typef '(or cons symbol))
101  #'(lambda (x) `(let (,x) nil)))
102(def-all-error-test let.12 'symbolp
103  #'(lambda (x) `(let ((,x)) nil)))
104
105(def-error-test let.13 (let ((x 0) (x 1)) x))
106
107;;; LET*
108
109(def-error-test let*.1 (let*))
110(def-error-test let*.2 (let* . x))
111(def-all-error-test let*.3 'listp #'(lambda (x) `(let* ,x nil)))
112(def-error-test let*.4 (let* () . x))
113(def-error-test let*.5 (let* (x . 1) nil))
114(def-error-test let*.6 (let* ((x) . y) nil))
115(def-error-test let*.7 (let* ((x 1 . 2)) nil))
116(def-error-test let*.8 (let* ((x 1 2)) nil))
117(def-error-test let*.10 (let* ((t 1)) t))
118(def-all-error-test let*.11 (typef '(or cons symbol))
119  #'(lambda (x) `(let* (,x) nil)))
120(def-all-error-test let*.12 'symbolp
121  #'(lambda (x) `(let* ((,x)) nil)))
122
123;;; PROGV
124
125(def-error-test progv.1 (progv))
126(def-error-test progv.2 (progv '(a)))
127(def-all-error-test progv.3 'listp '(progv x nil nil))
128(def-all-error-test progv.4 'listp '(progv '(a) x nil))
129
130;;; SETQ
131
132(def-error-test setq.1 (setq . x))
133(def-error-test setq.2 (let ((x t)) (setq x)))
134(def-error-test setq.3 (let ((x t)) (setq x . foo)))
135(def-error-test setq.4 (let ((x 1)) (setq x nil . foo)))
136(def-error-test setq.5 (let ((x 1) (y 2)) (setq x nil y)))
137(def-all-error-test setq.6 'symbolp #'(lambda (x) `(setq ,x nil)))
138(def-error-test setq.7
139  (let ((sym (gensym)))
140    (eval `(defconstant ,sym nil))
141    (eval `(setq ,sym t))
142    (eval sym)))
143
144;;; PSETQ
145
146(def-error-test psetq.1 (psetq . x))
147(def-error-test psetq.2 (let ((x t)) (psetq x)))
148(def-error-test psetq.3 (let ((x t)) (psetq x . foo)))
149(def-error-test psetq.4 (let ((x 1)) (psetq x nil . foo)))
150(def-error-test psetq.5 (let ((x 1) (y 2)) (psetq x nil y)))
151(def-all-error-test psetq.6 'symbolp #'(lambda (x) `(psetq ,x nil)))
152(def-error-test psetq.7
153  (let ((sym (gensym)))
154    (eval `(defconstant ,sym nil))
155    (eval `(psetq ,sym t))
156    (eval sym)))
157;;; I suggest it would be useful for PSETQ to detect when it is
158;;; being asked to assign to the same variable twice, since this
159;;; isn't well defined.
160(def-error-test psetq.8 (let ((x 0)) (psetq x 1 x 2) x))
161
162;;; BLOCK
163
164(def-error-test block.1 (block))
165(def-error-test block.2 (block . foo))
166(def-all-error-test block.3 'symbolp #'(lambda (x) `(block ,x)))
167(def-error-test block.4 (block nil . foo))
168
169;;; CATCH
170
171(def-error-test catch.1 (catch))
172(def-error-test catch.2 (catch . foo))
173(def-error-test catch.3 (catch 'tag . foo))
174(def-all-error-test catch.4 (constantly nil) '(catch x (throw x nil))
175  :vals *cl-symbols*)
176
177
178;;; GO
179
180(def-error-test go.1 (go))
181(def-error-test go.2 (go . foo))
182(def-all-error-test go.3 (typef '(or symbol integer))
183  #'(lambda (x) `(go ,x)))
184(def-error-test go.4 (tagbody (go done . foo) done))
185(def-error-test go.5 (tagbody (go done foo) done))
186
187;;; RETURN-FROM
188
189(def-error-test return-from.1 (return-from))
190(def-error-test return-from.2 (return-from . foo))
191(def-error-test return-from.3 (return-from foo))
192(def-error-test return-from.4 (block foo (return-from foo . t)))
193(def-error-test return-from.5 (block foo (return-from foo nil . 2)))
194(def-error-test return-from.6 (block foo (return-from foo nil 3)))
195
196;;; RETURN
197
198(def-error-test return.1 (return . x))
199(def-error-test return.2 (return nil . x))
200
201;;; TAGBODY
202
203(def-error-test tagbody.1 (tagbody . x))
204(def-all-error-test tagbody.2 (typef '(or symbol integer cons))
205  #'(lambda (x) `(tagbody ,x)))
206
207;;; THROW
208
209(def-error-test throw.1 (throw))
210(def-error-test throw.2 (throw . x))
211(def-error-test throw.3 (catch 'a (throw 'a)))
212(def-error-test throw.4 (catch 'a (throw 'a . x)))
213(def-error-test throw.5 (catch 'a (throw 'a 1 . x)))
214(def-error-test throw.6 (catch 'a (throw 'a 1 'x)))
215
216;;; UNWIND-PROTECT
217
218(def-error-test unwind-protect.1 (unwind-protect))
219(def-error-test unwind-protect.2 (unwind-protect . x))
220(def-error-test unwind-protect.3 (unwind-protect nil . x))
221
222;;; NOT
223
224(def-error-test not.1 (not . x))
225(def-error-test not.2 (not nil . x))
226
227
228;;; EQ
229
230(def-error-test eq.1 (eq . 1))
231(def-error-test eq.2 (eq 'x . 2))
232(def-error-test eq.3 (eq :foo 2 . 17))
233
234;;; EQL
235
236(def-error-test eql.1 (eql . 1))
237(def-error-test eql.2 (eql 'x . 2))
238(def-error-test eql.3 (eql :foo 2 . 17))
239
240;;; EQUAL
241
242(def-error-test equal.1 (equal . 1))
243(def-error-test equal.2 (equal 'x . 2))
244(def-error-test equal.3 (equal :foo 2 . 17))
245
246;;; EQUALP
247
248(def-error-test equalp.1 (equalp . 1))
249(def-error-test equalp.2 (equalp 'x . 2))
250(def-error-test equalp.3 (equalp :foo 2 . 17))
251
252;;; IDENTITY
253
254(def-error-test identity.1 (identity . 0))
255(def-error-test identity.2 (identity 0 . "foo"))
256
257;;; COMPLEMENT
258
259(def-error-test complement.1 (complement . 1.2))
260(def-error-test complement.2 (complement #'plusp . #(1 2)))
261(def-error-test complement.3 (complement #'zerop #*110101 . #c(1 2)))
262(def-all-error-test complement.4 'functionp '(complement x))
263
264;;; CONSTANTLY
265
266(def-error-test constantly.1 (constantly . 1/2))
267(def-error-test constantly.2 (constantly :foo . 1/2))
268
269;;; EVERY
270
271(def-error-test every.1 (every . :foo))
272(def-error-test every.2 (every 'null . (list)))
273(def-error-test every.3 (every (gensym) '(a b c d)))
274
275;;; SOME
276
277(def-error-test some.1 (some . :foo))
278(def-error-test some.2 (some 'null . (list)))
279(def-error-test some.3 (some (gensym) '(a b c d)))
280
281;;; NOTEVERY
282
283(def-error-test notevery.1 (notevery . :foo))
284(def-error-test notevery.2 (notevery 'null . (list)))
285(def-error-test notevery.3 (notevery (gensym) '(a b c d)))
286
287;;; NOTANY
288
289(def-error-test notany.1 (notany . :foo))
290(def-error-test notany.2 (notany 'null . (list)))
291(def-error-test notany.3 (notany (gensym) '(a b c d)))
292
293;;; AND
294
295(def-error-test and.1 (and . #.(make-hash-table)))
296(def-error-test and.2 (and t . :foo))
297
298;;; COND
299
300(def-error-test cond.1 (cond . 1))
301(def-error-test cond.2 (cond (t . 2)))
302(def-error-test cond.3 (cond nil))
303(def-error-test cond.4 (cond (nil) . "foo"))
304
305;;; IF
306
307(def-error-test if.1 (if))
308(def-error-test if.2 (if . t))
309(def-error-test if.3 (if t))
310(def-error-test if.4 (if nil))
311(def-error-test if.5 (if t . 1))
312(def-error-test if.6 (if nil . 2))
313(def-error-test if.7 (if t 1 . 2))
314(def-error-test if.8 (if nil #\x . #\y))
315(def-error-test if.9 (if t 1 2 . 3))
316(def-error-test if.10 (if nil #\x #\y . 1.23d4))
317(def-error-test if.11 (if t 1 2 3))
318(def-error-test if.12 (if nil #\x #\y nil nil nil))
319
320;;; OR
321
322(def-error-test or.1 (or . :foo))
323(def-error-test or.2 (or nil . :bar))
324
325;;; WHEN
326
327(def-error-test when.1 (when))
328(def-error-test when.2 (when . #\$))
329(def-error-test when.3 (when t . x))
330(def-error-test when.4 (when t nil . "A"))
331
332;;; UNLESS
333
334(def-error-test unless.1 (unless))
335(def-error-test unless.2 (unless . #*1011))
336(def-error-test unless.3 (unless nil . t))
337(def-error-test unless.4 (unless nil nil . #()))
Note: See TracBrowser for help on using the repository browser.