1 (enable-test-parallelism)
3 (with-test (:name
(make-array :bad-initial-contents
))
7 `(lambda () (make-array '(1) :initial-contents
'foo
))
10 (with-test (:name
(make-string-output-stream :bad-element-type
))
15 (make-string-output-stream :element-type
'((x))))
18 (with-test (:name
(coerce :bad-type-specifier
))
22 `(lambda () (coerce (list 2) 1))
25 (with-test (:name
:zombie-entry-point-reference
)
29 `(lambda () (labels ((%f
())) (%f
#'%f
)))
31 (with-test (:name
:ir1-optimize-combination-dead-node
)
38 (multiple-value-call #'%f2
(values)))))
41 (with-test (:name
(:bogus-block
&key
))
44 (checked-compile `(lambda (&key
(x (block 1 10))) x
)
47 (with-test (:name
:type-error-reporting
)
50 (checked-compile `(lambda ()
53 (cdr (1- (block b5
(if nil v3
0)))))))
56 (with-test (:name
:dx-on-deleted-nodes
)
59 (checked-compile `(lambda ()
60 (restart-bind ((1 3))))
63 (with-test (:name
:transform-call-dfo-consistency
)
68 (flet ((%f
(&optional x
) x
))
70 ;; Two of the %f calls are erroneous, with an extra argument
71 (flet ((%f6
(&key
(k (%f
(%f -
1 (%f -
2 -
3))))) 0))
75 (with-test (:name
:&aux-check-variable-names
)
79 `(lambda (&aux
(nil 10))
83 (with-test (:name
:mv-call-too-many-values
)
89 (apply #'%f1 a
2 (list 0))))
92 (with-test (:name
:mv-call-too-many-values.closure
)
98 (apply #'%f1 a
2 (list 0))))
101 (with-test (:name
(map :values-type
))
106 (map '* #'+ #(1) #(2)))
107 :allow-warnings t
))))
110 (with-test (:name
:bad-type-specifier
)
115 (make-array 10 :element-type
'((x))))
116 :allow-warnings t
))))
118 (with-test (:name
(make-array :bad-dimensions
))
130 :allow-warnings t
))))
132 (with-test (:name
(make-array :bad-dimensions
.2))
137 (make-array '(0 .
2)))
138 :allow-warnings t
))))
140 (with-test (:name
(make-array :bad-dimensions
.3))
146 :element-type
'fixnum
148 :allow-warnings t
))))
150 (with-test (:name
(make-array :bad-dimensions
.4))
155 (make-array (list 'x
)))
156 :allow-warnings t
))))
158 (with-test (:name
(make-array :initial-contents
:bad-macro
))
163 (make-array '(10) :initial-contents
(do)))
166 (with-test (:name
(make-array :dimensions
:bad-macro
))
174 (with-test (:name
(make-array :dimensions
:bad-propagated-value
))
179 (let ((x '(("foo"))))
180 (make-array (list x
) :fill-pointer
0)))
181 :allow-warnings t
))))
183 (with-test (:name
(make-array :dimensions
:unraveling-list
))
188 (make-array (list (list 10)) :adjustable x
))
189 :allow-warnings t
))))
191 (with-test (:name
:&rest-ref-bad-n
)
195 `(lambda (&rest a
) (lambda () (nth nil a
)))
196 :allow-warnings t
))))
198 (with-test (:name
:bad-type-specifier-handling
)
199 (multiple-value-bind (fun failure warnings
)
201 `(lambda (v) (typep v
'(unsigned-byte 8 x
(error ~s v
))))
203 (declare (ignore fun
))
205 (mapcar #'princ-to-string warnings
)))
207 (with-test (:name
:ldb-transform-macroexpand
)
211 `(lambda () (ldb (do) 0))
214 (with-test (:name
:bad-values-ftype
)
218 `(lambda () (declare (values 0)))
219 :allow-warnings t
))))
221 (with-test (:name
:bad-progv
)
225 `(lambda (x) (progv x
1))
230 `(lambda (x) (progv 1 x
))
231 :allow-warnings t
))))
233 (with-test (:name
:coerce-to-nil
)
237 '(lambda () (coerce (list t
) nil
))
238 :allow-warnings t
))))
240 (with-test (:name
:unknown-vector-type-conflict
)
244 '(lambda () (the (vector nonsense-type
) nil
))
246 :allow-style-warnings t
))))
248 (with-test (:name
:subseq-unknown-vector-type
)
252 '(lambda () (subseq (the (vector nonsense-type
) :x
) 0 1))
254 :allow-style-warnings t
))))
255 (with-test (:name
:derive-node-type-unknown-type
)
260 (let ((k (make-array 8 :element-type
'(unsigned-byte 8))))
261 (setf (aref k
0) (the unknown-type
(the integer x
)))
262 (setf k
(subseq "y" 0))))
264 :allow-style-warnings t
))))
266 (with-test (:name
:highly-nested-type-error
)
273 ',@ (loop for cons
= (list 1) then
(list cons
)
275 finally
(return cons
)))
278 :allow-warnings t
))))
280 (with-test (:name
:complex-member-type
)
281 (assert (= (length (nth-value 2
284 (typep x
'(complex (eql t
))))
288 (with-test (:name
:bad-optionals
)
292 (lambda (&optional
(a nil x
))
293 (declare (type integer x
))
295 :allow-warnings t
))))
297 (with-test (:name
:recursive-delete-lambda
)
310 (lambda (&optional m
) m
)))
313 :allow-warnings t
))))
315 (with-test (:name
:complex-number
)
316 (checked-compile-and-assert
320 (('(complex number
)) (condition 'error
))))
322 (with-test (:name
:aref-type-mismatch
)
326 (svref x
*break-on-signals
*))
327 :allow-warnings t
))))
329 (with-test (:name
:unknown-keys-propagation-error-checking
.1)
335 :allow-warnings t
))))
337 (with-test (:name
:unknown-keys-propagation-error-checking
.2)
341 (apply 'find
'(3 (1 2 3) :bad t
)))
342 :allow-warnings t
))))
345 (with-test (:name
:sequence-lvar-dimensions-dotted-list
)
348 '(lambda () (position 0 '(1 2 0 5 .
5)))
349 :allow-warnings t
))))
351 (with-test (:name
:source-form-context-dotted-list
)
354 '(lambda (y) `(defines ,@ (and x
) .
,y
))
355 :allow-warnings t
))))
357 (with-test (:name
:typep-transform-dotted-list
)
360 '(lambda (x) (typep x
(quote . z
)))
363 (with-test (:name
:member-transform-dotted-list
)
366 '(lambda (x) (member x
'(a . b
)))
367 :allow-warnings t
))))
369 (with-test (:name
:encode-universal-time
)
372 '(lambda () (encode-universal-time 0 0 0 1 1 1900 -
1))
373 :allow-style-warnings t
))))
375 (with-test (:name
:search-transform-bad-index
)
378 (search '(0 1 0 2) a
:start1
4 :end1
5))))
380 (with-test (:name
:bound-mismatch-union-types
)
384 (declare ((or (simple-string 10) (simple-string 15)) x
))
386 :allow-warnings t
))))
388 (with-test (:name
:uses-with-bad-types
)
392 (the integer
(if x
10)))
393 :allow-style-warnings t
))))
395 (with-test (:name
:constant-modification-local-function
)
396 (assert (= (length (nth-value 2
400 (setf (aref a
0) 10)))
406 (with-test (:name
:improper-list
)
409 '(lambda (x) (concatenate 'string x
'(#\a .
#\b)))
413 '(lambda (x) (concatenate 'list x
'(1 2 .
3)))
417 '(lambda (x) (concatenate 'vector x
'(1 2 .
3)))
418 :allow-warnings t
))))
420 (with-test (:name
:improper-list
.2)
424 (member-if #'(lambda (x) (evenp x
)) '(1 2 3 .
4)))
430 :allow-warnings t
))))
432 (with-test (:name
:improper-list
.3)
436 (let ((x '(1 2 .
3)))
438 :allow-warnings t
))))
440 (with-test (:name
:call-nil
)
441 (checked-compile-and-assert
445 (() (condition 'undefined-function
)))
446 (checked-compile-and-assert
452 ((nil) (condition 'undefined-function
))))
454 (with-test (:name
(:valid-callable-argument
:toplevel-xep
))
455 (assert (nth-value 2 (checked-compile `(lambda (l) (find-if (lambda ()) l
))
456 :allow-warnings t
))))
458 (with-test (:name
(:valid-callable-argument
:handler-bind
))
459 (assert (nth-value 2 (checked-compile
460 `(lambda (l) (handler-bind ((error (lambda ()))) (funcall l
)))
461 :allow-warnings t
))))
463 (with-test (:name
(:valid-callable-argument
:closure
))
464 (assert (nth-value 2 (checked-compile
465 `(lambda (l) (the (function (t)) (lambda () l
)))
466 :allow-warnings t
))))
468 (with-test (:name
:bad-macros
)
472 `(lambda () (coerce 'integer
(restart-bind foo
)))
475 (with-test (:name
:bad-funcall-macros
)
479 `(lambda () (funcall (lambda)))
482 (with-test (:name
:inlining-bad-code
)
486 `(lambda (x &rest args
)
490 (every #'identity args
(every #'identity args
)))
492 :allow-style-warnings t
493 :allow-warnings t
))))
495 (with-test (:name
:keyword-type-checking
)
500 (make-array 10 (list x
) x
))
501 :allow-warnings t
))))
503 (with-test (:name
:unused-local-functions
)
504 (labels ((find-note (x)
505 (loop for note in
(nth-value 4 (checked-compile x
))
506 thereis
(and (typep note
'sb-ext
:code-deletion-note
)
507 (eql (search "deleting unused function"
508 (princ-to-string note
))
511 (assert (find-note `(lambda () (flet (,f
)))))
512 (assert (not (find-note `(lambda (x)
514 (and x
(not x
) (f)))))))))
517 (check '(f (&key k
) k
))
518 (check '(f (&rest args
) args
))
519 (check '(f (&optional o
) o
))
520 (check '(f (&optional
)))))
522 (with-test (:name
:calling-ignored-local
)
528 (declare (ignore #'f
))
530 :allow-style-warnings t
))))
532 (with-test (:name
:inappropriate-declare
)
536 `(lambda (x y
) (print-unreadable-object (x y
) (declare (optimize))))
541 `(lambda () (restart-bind () (declare (optimize)) 42))
546 `(lambda () (prog1 10 (declare (optimize))))
549 (with-test (:name
:reduce-initial-value
)
554 (reduce (lambda (x y
)
563 (reduce (lambda (x y
)
569 (checked-compile-and-assert
573 (reduce (lambda (x y
)
580 (with-test (:name
:reduce-initial-value-from-end
)
581 (checked-compile-and-assert
584 (reduce #'funcall s
:from-end t
:initial-value
'(1)))
586 (checked-compile-and-assert
589 (reduce #'funcall s
:from-end e
:initial-value
'(1)))
591 (checked-compile-and-assert
594 (reduce #'funcall
#*1 :from-end e
:initial-value
1 :key
(lambda (x) x
'list
)))
595 ((t) '(1) :test
#'equal
))
596 (checked-compile-and-assert
599 (reduce #'funcall
#*1 :from-end t
:initial-value
1 :key
(lambda (x) x
'list
)))
600 (() '(1) :test
#'equal
))
601 (checked-compile-and-assert
604 (reduce (the (function ((unsigned-byte 16) (unsigned-byte 8))) f
) l
606 ((#'+ '(1 2 3)) 306)))
608 (with-test (:name
:get-defined-fun-lambda-list-error
)
609 (assert (nth-value 1 (checked-compile '(lambda () (defun x 10)) :allow-failure t
))))
611 (with-test (:name
:dolist-mismatch
)
613 (checked-compile '(lambda (x)
614 (dolist (x (the integer x
))))
615 :allow-warnings
'sb-int
:type-warning
))))
617 (with-test (:name
:loop-list-mismatch
)
619 (checked-compile '(lambda (x)
620 (loop for y in
(the integer x
)))
621 :allow-warnings
'sb-int
:type-warning
)))
623 (checked-compile '(lambda (x)
624 (loop for y on
(the integer x
)))
625 :allow-warnings
'sb-int
:type-warning
))))
627 (with-test (:name
:mapcar-list-mismatch
)
629 (checked-compile '(lambda (z)
630 (mapl #'car
(the integer z
)))
631 :allow-warnings
'sb-int
:type-warning
)))
633 (checked-compile '(lambda (f z x
)
634 (mapcar f
(the integer z
) (the integer x
)))
635 :allow-warnings
'sb-int
:type-warning
))))
637 (with-test (:name
:aref-too-many-subscripts
)
639 (checked-compile `(lambda (a) (aref a
,@(loop repeat array-rank-limit collect
0)))
640 :allow-warnings
'warning
))))
642 (with-test (:name
:defclass-bad-type
)
645 `(lambda () (defclass ,(gensym) () ((s :type
(2)))))
646 :allow-warnings
'warning
))))
648 (with-test (:name
:macro-as-a-function
)
651 `(lambda (x) (find-if 'and x
))
652 :allow-warnings
'warning
)))
655 `(lambda (x) (funcall 'if x
))
656 :allow-warnings
'warning
)))
659 `(lambda (x) (mapcar 'and x
))
660 :allow-warnings
'warning
))))
662 (with-test (:name
:replace-type-mismatch
)
666 (declare (bit-vector x
)
668 (replace x y
:start1
10))
669 :allow-warnings
'warning
))))
671 (with-test (:name
:substitute-type-mismatch
)
676 (substitute 10 #\a x
))
677 :allow-warnings
'warning
))))
679 (with-test (:name
:make-array-initial-contents-type-mismatch
)
683 (make-array n
:element-type
'bit
:initial-contents
(the string c
)))
684 :allow-warnings
'warning
))))
686 (with-test (:name
:make-array-initial-contents-constant-type-mismatch
)
690 (make-array n
:element-type
'bit
:initial-contents
'(a b c
)))
691 :allow-warnings
'warning
))))
694 (with-test (:name
:replace-constant-type-mismatch
)
699 (replace x
'(1 2 3)))
700 :allow-warnings
'warning
))))
702 (with-test (:name
:fill-type-mismatch
)
708 :allow-warnings
'warning
))))
710 (with-test (:name
:vector-push-type-mismatch
)
716 :allow-warnings
'warning
)))
721 (vector-push-extend 1 x
))
722 :allow-warnings
'warning
))))
724 (with-test (:name
:defmethod-malformed-let
*)
728 (cl:defmethod
,(gensym) ()
733 (with-test (:name
:position-derive-empty-type
)
734 (multiple-value-bind (fun failure warning
)
737 (position #\a (the simple-string s
) :start
4 :end
2))
739 (declare (ignore failure
))
741 (assert-error (funcall fun
"abcdef") sb-kernel
:bounding-indices-bad-error
)))
743 (with-test (:name
:cast-movement-empty-types
)
748 sum
(the cons
(signum x
))))
749 :allow-warnings
'warning
))))
751 (with-test (:name
:dead-code-after-ir1-conversion
)
755 (labels ((scan (ch l
)
757 (let ((d (digit-char-p ch r
)))
758 (labels ((fix (x i l
)
761 (cons (cons x i
) nil
))
763 (fix (+ (* 2 (aref v i
)) x
) (1+ i
) nil
)
765 (cons (cons x i
) l
))))))
770 (with-test (:name
:muffle-unknown-type
)
773 `(lambda () (declare (sb-ext:muffle-conditions foo
)) nil
)
774 :allow-style-warnings t
))))
776 (with-test (:name
:format-char
)
781 :allow-warnings t
))))
783 (with-test (:name
:format-r
)
788 :allow-warnings t
))))
790 (with-test (:name
:multiple-uses-funargs
)
798 :allow-style-warnings t
))))