source: trunk/source/tests/ansi-tests/beyond-ansi/errors-data-and-control-flow-3.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: 11.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Jun 14 07:00:58 2005
4;;;; Contains: Tests of non-ANSI exceptions sutation from CLHS section 5, part 3
5(in-package :ba-test)
6
7(compile-and-load "ba-aux.lsp")
8
9;;; CASE
10
11(def-error-test case.1 (case . 1))
12(def-error-test case.2 (case nil . 1))
13(def-error-test case.3 (case nil (nil . 1)))
14(def-error-test case.4 (case 'x nil))
15(def-error-test case.5 (case 'x ((nil . x) 1)))
16(def-error-test case.6 (case))
17
18;;; CCASE
19
20(def-error-test ccase.1 (ccase . 1))
21(def-error-test ccase.2 (let ((x nil)) (ccase x . 1)))
22(def-error-test ccase.3 (let ((x nil)) (ccase x (nil . 1))))
23(def-error-test ccase.4 (let ((x 'x)) (ccase x nil)))
24(def-error-test ccase.5 (let ((x 'x)) (ccase x ((nil . x) 1))))
25(def-error-test ccase.6 (ccase 1 (1 nil))) ;; 1 is not a place!
26(def-error-test ccase.7 (ccase))
27
28;;; ECASE
29
30(def-error-test ecase.1 (ecase . 1))
31(def-error-test ecase.2 (ecase nil . 1))
32(def-error-test ecase.3 (ecase nil (nil . 1)))
33(def-error-test ecase.4 (ecase 'x nil))
34(def-error-test ecase.5 (ecase 'x ((nil . x) 1)))
35(def-error-test ecase.6 (ecase))
36
37;;; TYPECASE
38
39(def-error-test typecase.1 (typecase))
40(def-error-test typecase.2 (typecase . :foo))
41(def-error-test typecase.3 (typecase 'x . #\X))
42(def-error-test typecase.4 (typecase 'x (#.(gensym) t)))
43(def-error-test typecase.5 (typecase 'x (symbol . :foo)))
44(def-error-test typecase.6 (typecase 'x . :foo))
45(def-error-test typecase.7 (typepcase 'x (t . :foo)))
46(def-error-test typecase.8 (typepcase 'x (otherwise . :foo)))
47
48;;; CTYPECASE
49
50(def-error-test ctypecase.1 (ctypecase))
51(def-error-test ctypecase.2 (ctypecase . :foo))
52(def-error-test ctypecase.3 (let ((x 'x)) (ctypecase x . #\X)))
53(def-error-test ctypecase.4 (let ((x 'x)) (ctypecase x (#.(gensym) t))))
54(def-error-test ctypecase.5 (let ((x 'x)) (ctypecase x (symbol . :foo))))
55(def-error-test ctypecase.6 (let ((x 'x)) (ctypecase x . :foo)))
56(def-error-test ctypecase.7 (let ((x 'x)) (ctypecase x (t . :foo))))
57(def-error-test ctypecase.8 (let ((x 'x)) (ctypecase x (otherwise . :foo))))
58(def-error-test ctypecase.9 (ctypecase 1 (integer :bad)))
59
60;;; ETYPECASE
61
62(def-error-test etypecase.1 (etypecase))
63(def-error-test etypecase.2 (etypecase . :foo))
64(def-error-test etypecase.3 (etypecase 'x . #\X))
65(def-error-test etypecase.4 (etypecase 'x (#.(gensym) t)))
66(def-error-test etypecase.5 (etypecase 'x (symbol . :foo)))
67(def-error-test etypecase.6 (etypecase 'x . :foo))
68
69;;; MULTIPLE-VALUE-BIND
70
71(def-error-test multiple-value-bind.1 (multiple-value-bind))
72(def-error-test multiple-value-bind.2 (multiple-value-bind .
73                                          #.(1+ most-positive-fixnum)))
74(def-error-test multiple-value-bind.3 (multiple-value-bind (x)))
75(def-error-test multiple-value-bind.4 (multiple-value-bind (x . y) 1 x))
76(def-error-test multiple-value-bind.5 (multiple-value-bind (x) . :foo))
77(def-error-test multiple-value-bind.6 (multiple-value-bind (x) nil . :bar))
78(def-error-test multiple-value-bind.7
79  (multiple-value-bind (x) nil "doc string" . 1))
80(def-error-test multiple-value-bind.8
81  (multiple-value-bind (x) nil (declare) . 1))
82(def-error-test multiple-value-bind.9
83  (multiple-value-bind (x) 1 (declare (type symbol x)) x))
84(def-error-test multiple-value-bind.10
85  (multiple-value-bind (x) 1 nil (declare) nil))
86(def-error-test multiple-value-bind.11
87  (multiple-value-bind (x) 1 "foo" "bar" (declare) nil))
88
89;;; MULTIPLE-VALUE-CALL
90
91(def-error-test multiple-value-call.1 (multiple-value-call))
92(def-error-test multiple-value-call.2 (multiple-value-call . :x))
93(def-error-test multiple-value-call.3 (multiple-value-call 'list . :x))
94(def-error-test multiple-value-call.4 (multiple-value-call 'list 1 . :x))
95(def-all-error-test multiple-value-call.5 'function-designator-p
96  '(multiple-value-call x nil))
97(def-error-test multiple-value-call.6 (multiple-value-call (gensym)))
98
99;;; MULTIPLE-VALUE-LIST
100
101(def-error-test multiple-value-list.1 (multiple-value-list))
102(def-error-test multiple-value-list.2 (multiple-value-list . 1))
103(def-error-test multiple-value-list.3 (multiple-value-list 1 . 2))
104(def-error-test multiple-value-list.4 (multiple-value-list 1 2))
105
106;;; MULTIPLE-VALUE-PROG1
107
108(def-error-test multiple-value-prog1.1 (multiple-value-prog1))
109(def-error-test multiple-value-prog1.2 (multiple-value-prog1 . 1))
110(def-error-test multiple-value-prog1.3 (multiple-value-prog1 :x . :y))
111
112;;; MULTIPLE-VALUE-SETQ
113
114(def-error-test multiple-value-setq.1 (multiple-value-setq))
115(def-error-test multiple-value-setq.2 (let (x) (multiple-value-setq (x)) x))
116(def-error-test multiple-value-setq.3
117  (let (x y) (multiple-value-setq (x . y) nil (list x y))))
118(def-all-error-test multiple-value-setq.4 'symbolp
119  #'(lambda (x) `(multiple-value-setq (,x) nil)))
120(def-all-error-test multiple-value-setq.5 (constantly nil)
121  #'(lambda (x) `(multiple-value-setq (,x) nil))
122  :vals cl-test::*cl-constant-symbols*)
123
124;;; VALUES
125
126(def-all-error-test values.1 'listp #'(lambda (x) (cons 'values x)))
127(def-all-error-test values.2 'listp #'(lambda (x) (list* 'values 1 x)))
128
129;;; NTH-VALUE
130
131(def-error-test nth-value.1 (nth-value))
132(def-error-test nth-value.2 (nth-value 0))
133(def-error-test nth-value.3 (nth-value 1 '(a b c) 2))
134(def-all-error-test nth-value.4 (constantly nil) #'(lambda (x) `(nth-value ',x)))
135(def-all-error-test nth-value.5 (constantly nil) #'(lambda (x) `(nth-value . ,x)))
136(def-all-error-test nth-value.6 (constantly nil) #'(lambda (x) `(nth-value 0 . ,x)))
137(def-all-error-test nth-value.7 'integerp #'(lambda (x) `(nth-value ',x nil)))
138(def-error-test nth-value.8 (nth-value -1 'x))
139(def-all-error-test nth-value.9 'null #'(lambda (x) `(nth-value 0 'a . ,x)))
140
141;;; PROG
142
143(def-error-test prog.1 (prog))
144(def-all-error-test prog.2 'listp #'(lambda (x) `(prog . ,x)))
145(def-all-error-test prog.3 'listp #'(lambda (x) `(prog ,x)))
146(def-all-error-test prog.4 'listp #'(lambda (x) `(prog () . ,x)))
147(def-all-error-test prog.5 (typef '(or symbol cons))  #'(lambda (x) `(prog (,x))))
148(def-all-error-test prog.6 'listp #'(lambda (x) `(prog (v . ,x))))
149(def-all-error-test prog.7 'listp #'(lambda (x) `(prog ((v . ,x)))))
150(def-error-test prog.8 (prog ((x nil nil))))
151(def-all-error-test prog.9 'null #'(lambda (x) `(prog ((v nil . ,x)))))
152
153;;; PROG*
154
155(def-error-test prog*.1 (prog*))
156(def-all-error-test prog*.2 'listp #'(lambda (x) `(prog* . ,x)))
157(def-all-error-test prog*.3 'listp #'(lambda (x) `(prog* ,x)))
158(def-all-error-test prog*.4 'listp #'(lambda (x) `(prog* () . ,x)))
159(def-all-error-test prog*.5 (typef '(or symbol cons))  #'(lambda (x) `(prog* (,x))))
160(def-all-error-test prog*.6 'listp #'(lambda (x) `(prog* (v . ,x))))
161(def-all-error-test prog*.7 'listp #'(lambda (x) `(prog* ((v . ,x)))))
162(def-error-test prog*.8 (prog* ((x nil nil))))
163(def-all-error-test prog*.9 'null #'(lambda (x) `(prog* ((v nil . ,x)))))
164
165;;; PROG1
166
167(def-error-test prog1.1 (prog1))
168(def-all-error-test prog1.2 #'listp #'(lambda (x) `(prog1 . ,x)))
169(def-all-error-test prog1.3 #'listp #'(lambda (x) `(prog1 nil . ,x)))
170
171;;; PROG2
172
173(def-error-test prog2.1 (prog2))
174(def-all-error-test prog2.2 #'listp #'(lambda (x) `(prog2 . ,x)))
175(def-error-test prog2.3 (prog2 t))
176(def-all-error-test prog2.4 #'listp #'(lambda (x) `(prog2 nil . ,x)))
177(def-all-error-test prog2.5 #'listp #'(lambda (x) `(prog2 'a 'b . ,x)))
178(def-all-error-test prog2.6 #'listp #'(lambda (x) `(prog2 'a 'b nil . ,x)))
179
180;;; PROGN
181
182(def-all-error-test progn.1 'listp #'(lambda (x) `(progn . ,x)))
183(def-all-error-test progn.2 'listp #'(lambda (x) `(progn nil . ,x)))
184(def-all-error-test progn.3 'listp #'(lambda (x) `(progn 'a 'b . ,x)))
185
186;;; DEFINE-MODIFY-MACRO
187
188(def-error-test define-modify-macro.1 (define-modify-macro))
189(def-error-test define-modify-macro.2 (define-modify-macro #.(gensym)))
190(def-all-error-test define-modify-macro.3 'symbolp #'(lambda (x) `(define-modify-macro ,x ())))
191(def-all-error-test define-modify-macro.4 'listp #'(lambda (x) `(define-modify-macro #.(gensym) ,x)))
192(def-all-error-test define-modify-macro.5 'listp #'(lambda (x) `(define-modify-macro #.(gensym) () . ,x)))
193(def-all-error-test define-modify-macro.6 'symbolp #'(lambda (x) `(define-modify-macro #.(gensym) () ,x)))
194(def-all-error-test define-modify-macro.7 'stringp #'(lambda (x) `(define-modify-macro #.(gensym) () #.(gensym) ,x)))
195(def-all-error-test define-modify-macro.8 'listp #'(lambda (x) `(define-modify-macro #.(gensym) () #.(gensym) . ,x)))
196(def-all-error-test define-modify-macro.9 'listp #'(lambda (x) `(define-modify-macro #.(gensym) () #.(gensym) "foo" . ,x)))
197(def-all-error-test define-modify-macro.10 (constantly nil)
198  #'(lambda (x) `(define-modify-macro #.(gensym) () #.(gensym) "foo" ,x)))
199
200;;; DEFSETF
201
202(def-error-test defsetf.1 (defsetf))
203(def-error-test defsetf.2 (defsetf #.(gensym)))
204(def-all-error-test defsetf.3 'listp #'(lambda (x) `(defsetf ,x)))
205(def-all-error-test defsetf.4 'listp #'(lambda (x) `(defsetf #.(gensym) . ,x)))
206(def-all-error-test defsetf.5 'listp #'(lambda (x) `(defsetf #.(gensym) #.(gensym) . ,x)))
207(def-all-error-test defsetf.6 'stringp #'(lambda (x) `(defsetf #.(gensym) #.(gensym) ,x)))
208(def-all-error-test defsetf.7 'null #'(lambda (x) `(defsetf #.(gensym) #.(gensym) "foo" . ,x)))
209(def-all-error-test defsetf.8 (constantly nil) #'(lambda (x) `(defsetf #.(gensym) #.(gensym) "foo" ,x)))
210(def-all-error-test defsetf.9 (typef '(or list symbol)) #'(lambda (x) `(defsetf #.(gensym) ,x)))
211
212;;; Need long form defsetf error tests
213
214;;; FIXME: add tests for defsetf-lambda-lists
215
216(def-all-error-test defsetf.10 'symbolp #'(lambda (x)  `(defsetf #.(gensym) (#1=#.(gensym)) (,x) #1#)))
217(def-all-error-test defsetf.11 'listp #'(lambda (x) `(defsetf #.(gensym) (#.(gensym)) ., x)))
218(def-all-error-test defsetf.12 'listp #'(lambda (x) `(defsetf #.(gensym) (#.(gensym)) , x)))
219(def-all-error-test defsetf.13 'listp #'(lambda (x) `(defsetf #.(gensym) (#.(gensym)) (a . ,x))))
220
221(def-error-test defsetf.14 (defsetf #.(gensym) () () nil (declare (optimize)) nil))
222(def-error-test defsetf.15 (defsetf #.(gensym) () () "foo" "bar" (declare (optimize)) nil))
223
224;;; FIXME -- Add tests for DEFINE-SETF-EXPANDER
225
226(def-error-test get-setf-expansion.1 (get-setf-expansion))
227(def-all-error-test get-setf-expansion.2 'listp #'(lambda (x) `(get-setf-expansion . ,x)))
228(def-all-error-test get-setf-expansion.3 (typef '(or list symbol))
229  #'(lambda (x) `(get-setf-expansion ,x)))
230
231;;; FIXME -- figure out how to test for invalid environment objects
232;;;   Must make an assumption about what can be an environment
233
234;;; SETF tests
235
236(def-all-error-test setf.1 (constantly nil) #'(lambda (x) `(setf ,x)))
237(def-all-error-test setf.2 'listp #'(lambda (x) `(setf . ,x)))
238(def-all-error-test setf.3 'listp #'(lambda (x) `(setf ,x nil)))
239(def-all-error-test setf.4 'listp #'(lambda (x) `(let (a) (setf a . ,x))))
240
241;;; PSETF tests
242
243(def-all-error-test psetf.1 (constantly nil) #'(lambda (x) `(psetf ,x)))
244(def-all-error-test psetf.2 'listp #'(lambda (x) `(psetf . ,x)))
245(def-all-error-test psetf.3 'listp #'(lambda (x) `(psetf ,x nil)))
246(def-all-error-test psetf.4 'listp #'(lambda (x) `(let (a) (psetf a . ,x))))
247
248;;; SHIFTF tests
249
250(def-error-test shiftf.1 (shiftf))
251(def-all-error-test shiftf.2 'listp #'(lambda (x) `(shiftf . ,x)))
252(def-all-error-test shiftf.3 (constantly nil) #'(lambda (x) `(shiftf ,x)))
253(def-all-error-test shiftf.4 'listp #'(lambda (x) `(let (a) (shiftf a . ,x))))
254(def-all-error-test shiftf.5 'listp #'(lambda (x) `(shiftf ,x nil)))
255(def-all-error-test shiftf.6 'listp #'(lambda (x) `(let (a b) (shiftf a b . ,x))))
256(def-all-error-test shiftf.7 'listp #'(lambda (x) `(let (a) (shiftf ,x a nil))))
257(def-all-error-test shiftf.8 'listp #'(lambda (x) `(let (a) (shiftf a ,x nil))))
258
259;;; ROTATEF tests
260
261(def-all-error-test rotatef.1 'listp #'(lambda (x) `(rotatef . ,x)))
262(def-all-error-test rotatef.2 'listp #'(lambda (x) `(rotatef ,x)))
263(def-all-error-test rotatef.3 'listp #'(lambda (x) `(let (a) (rotatef a ,x))))
264(def-all-error-test rotatef.4 'listp #'(lambda (x) `(let (a) (rotatef a . ,x))))
265(def-all-error-test rotatef.5 'listp #'(lambda (x) `(let (a) (rotatef ,x a))))
Note: See TracBrowser for help on using the repository browser.