Don't try to print highly nested forms for type errors.
[sbcl.git] / tests / bad-code.pure.lisp
blob049472642fc35b1bbe551b0765345e43137c7eb1
1 (in-package :cl-user)
3 (with-test (:name (make-array :bad-initial-contents))
4 (assert
5 (nth-value 1
6 (checked-compile
7 `(lambda () (make-array '(1) :initial-contents 'foo))
8 :allow-warnings t))))
10 (with-test (:name (make-string-output-stream :bad-element-type))
11 (assert
12 (nth-value 1
13 (checked-compile
14 `(lambda ()
15 (make-string-output-stream :element-type '((x))))
16 :allow-warnings t))))
18 (with-test (:name (coerce :bad-type-specifier))
19 (assert
20 (nth-value 1
21 (checked-compile
22 `(lambda () (coerce (list 2) 1))
23 :allow-warnings t))))
25 (with-test (:name :zombie-entry-point-reference)
26 (assert
27 (nth-value 1
28 (checked-compile
29 `(lambda () (labels ((%f ())) (%f #'%f)))
30 :allow-warnings t))))
31 (with-test (:name :ir1-optimize-combination-dead-node)
32 (assert
33 (nth-value 1
34 (checked-compile
35 `(lambda ()
36 (flet ((%f2 (x) x))
37 (list (%f2 1)
38 (multiple-value-call #'%f2 (values)))))
39 :allow-warnings t))))
41 (with-test (:name (:bogus-block &key))
42 (assert
43 (nth-value 1
44 (checked-compile `(lambda (&key (x (block 1 10))) x)
45 :allow-failure t))))
47 (with-test (:name :type-error-reporting)
48 (assert
49 (nth-value 1
50 (checked-compile `(lambda ()
51 (lambda ()
52 (let ((v3 0))
53 (cdr (1- (block b5 (if nil v3 0)))))))
54 :allow-warnings t))))
56 (with-test (:name :dx-on-deleted-nodes)
57 (assert
58 (nth-value 1
59 (checked-compile `(lambda ()
60 (restart-bind ((1 3))))
61 :allow-warnings t))))
63 (with-test (:name :transform-call-dfo-consistency)
64 (assert
65 (nth-value 1
66 (checked-compile
67 `(lambda ()
68 (flet ((%f (&optional x) x))
69 (%f)
70 ;; Two of the %f calls are erroneous, with an extra argument
71 (flet ((%f6 (&key (k (%f (%f -1 (%f -2 -3))))) 0))
72 5)))
73 :allow-warnings t))))
75 (with-test (:name :&aux-check-variable-names)
76 (assert
77 (nth-value 1
78 (checked-compile
79 `(lambda (&aux (nil 10))
80 nil)
81 :allow-failure t))))
83 (with-test (:name :mv-call-too-many-values)
84 (assert
85 (nth-value 1
86 (checked-compile
87 `(lambda (a)
88 (flet ((%f1 (x) x))
89 (apply #'%f1 a 2 (list 0))))
90 :allow-warnings t))))
92 (with-test (:name :mv-call-too-many-values)
93 (assert
94 (nth-value 1
95 (checked-compile
96 `(lambda ()
97 (make-array (list 'x)))
98 :allow-warnings t))))
100 (with-test (:name (map :values-type))
101 (assert
102 (nth-value 1
103 (checked-compile
104 `(lambda ()
105 (map '* #'+ #(1) #(2)))
106 :allow-warnings t))))
109 (with-test (:name :bad-type-specifier)
110 (assert
111 (nth-value 1
112 (checked-compile
113 `(lambda ()
114 (make-array 10 :element-type '((x))))
115 :allow-warnings t))))
117 (with-test (:name (make-array :bad-dimensions))
118 (assert
119 (nth-value 1
120 (checked-compile
121 `(lambda ()
122 (make-array '(x)))
123 :allow-warnings t)))
124 (assert
125 (nth-value 1
126 (checked-compile
127 `(lambda ()
128 (make-array '(-10)))
129 :allow-warnings t))))
131 (with-test (:name (make-array :bad-dimensions.2))
132 (assert
133 (nth-value 1
134 (checked-compile
135 `(lambda ()
136 (make-array '(0 . 2)))
137 :allow-warnings t))))
139 (with-test (:name (make-array :bad-dimensions.3))
140 (assert
141 (nth-value 1
142 (checked-compile
143 `(lambda ()
144 (make-array '(0 . 2)
145 :element-type 'fixnum
146 :adjustable t))
147 :allow-warnings t))))
149 (with-test (:name (make-array :initial-contents :bad-macro))
150 (assert
151 (nth-value 1
152 (checked-compile
153 `(lambda ()
154 (make-array '(10) :initial-contents (do)))
155 :allow-failure t))))
157 (with-test (:name (make-array :dimensions :bad-macro))
158 (assert
159 (nth-value 1
160 (checked-compile
161 `(lambda ()
162 (make-array (do)))
163 :allow-failure t))))
165 (with-test (:name :&rest-ref-bad-n)
166 (assert
167 (nth-value 1
168 (checked-compile
169 `(lambda (&rest a) (lambda () (nth nil a)))
170 :allow-warnings t))))
172 (with-test (:name :bad-type-specifier-handling)
173 (multiple-value-bind (fun failure warnings)
174 (checked-compile
175 `(lambda (v) (typep v '(unsigned-byte 8 x (error ~s v))))
176 :allow-warnings t)
177 (declare (ignore fun))
178 (assert failure)
179 (mapcar #'princ-to-string warnings)))
181 (with-test (:name :ldb-transform-macroexpand)
182 (assert
183 (nth-value 1
184 (checked-compile
185 `(lambda () (ldb (do) 0))
186 :allow-failure t))))
188 (with-test (:name :bad-values-ftype)
189 (assert
190 (nth-value 1
191 (checked-compile
192 `(lambda () (declare (values 0)))
193 :allow-warnings t))))
195 (with-test (:name :bad-progv)
196 (assert
197 (nth-value 1
198 (checked-compile
199 `(lambda (x) (progv x 1))
200 :allow-warnings t)))
201 (assert
202 (nth-value 1
203 (checked-compile
204 `(lambda (x) (progv 1 x))
205 :allow-warnings t))))
207 (with-test (:name :coerce-to-nil)
208 (assert
209 (nth-value 1
210 (checked-compile
211 '(lambda () (coerce (list t) nil))
212 :allow-warnings t))))
214 (with-test (:name :unknown-vector-type-conflict)
215 (assert
216 (nth-value 1
217 (checked-compile
218 '(lambda () (the (vector nonsense-type) nil))
219 :allow-warnings t
220 :allow-style-warnings t))))
222 (with-test (:name :subseq-unknown-vector-type)
223 (assert
224 (nth-value 1
225 (checked-compile
226 '(lambda () (subseq (the (vector nonsense-type) :x) 0 1))
227 :allow-warnings t
228 :allow-style-warnings t))))
229 (with-test (:name :derive-node-type-unknown-type)
230 (assert
231 (nth-value 3
232 (checked-compile
233 '(lambda (x)
234 (let ((k (make-array 8 :element-type '(unsigned-byte 8))))
235 (setf (aref k 0) (the unknown-type (the integer x)))
236 (setf k (subseq "y" 0))))
237 :allow-warnings t
238 :allow-style-warnings t))))
240 (with-test (:name :highly-nested-type-error)
241 (assert (nth-value 1
242 (checked-compile
243 `(lambda ()
244 (macrolet ((macro ()
245 `((lambda (x)
246 (declare (number x))
247 ',@ (loop repeat 10000
248 for cons = (list 1) then (list cons)
249 finally (return cons)))
250 t)))
251 (macro)))
252 :allow-warnings t))))