X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fcompiler.pure.lisp;h=a7fd779e3af1ecee6e97bc342d51c9416fb54271;hb=fd79e33e6b6dacdc52cf6668a5bb7adf75aad6c1;hp=f2cba5fa3723b04e8ca4415713fe7ae5e811b652;hpb=4af56c115ef7ec63e06be677f9dfbf8116882e4c;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index f2cba5f..a7fd779 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2871,3 +2871,55 @@ (adjust-array y '(3 5)) (array-dimension y 0)))))) (assert (= 3 (funcall f (make-array '(4 4) :adjustable t)))))) + +(with-test (:name :with-timeout-code-deletion-note) + (handler-bind ((sb-ext:code-deletion-note #'error)) + (compile nil `(lambda () + (sb-ext:with-timeout 0 + (sleep 1)))))) + +(with-test (:name :full-warning-for-undefined-type-in-cl) + (assert (eq :full + (handler-case + (compile nil `(lambda (x) (the replace x))) + (style-warning () + :style) + (warning () + :full))))) + +(with-test (:name :single-warning-for-single-undefined-type) + (let ((n 0)) + (handler-bind ((warning (lambda (c) + (declare (ignore c)) + (incf n)))) + (compile nil `(lambda (x) (the #:no-type x))) + (assert (= 1 n)) + (compile nil `(lambda (x) (the 'fixnum x))) + (assert (= 2 n))))) + +(with-test (:name :complex-subtype-dumping-in-xc) + (assert + (= sb-vm:complex-single-float-widetag + (sb-kernel:widetag-of + (sb-vm:saetp-initial-element-default (sb-c::find-saetp '(complex single-float)))))) + (assert + (= sb-vm:complex-double-float-widetag + (sb-kernel:widetag-of + (sb-vm:saetp-initial-element-default (sb-c::find-saetp '(complex double-float))))))) + +(with-test (:name :complex-single-float-fill) + (assert (every (lambda (x) (= #c(1.0 2.0) x)) + (funcall + (compile nil + `(lambda (n x) + (make-array (list n) + :element-type '(complex single-float) + :initial-element x))) + 10 + #c(1.0 2.0))))) + +(with-test (:name :regression-1.0.28.21) + (let ((fun (compile nil `(lambda (x) (typep x '(simple-array * 1)))))) + (assert (funcall fun (vector 1 2 3))) + (assert (funcall fun "abc")) + (assert (not (funcall fun (make-array '(2 2)))))))