(test-comparison > double-float (/ 0d0 0d0) 0d0)
(test-comparison > double-float 0d0 (/ 0d0 0d0)))))
+(with-test (:name :car-and-cdr-type-derivation-conservative)
+ (let ((f1 (compile nil
+ `(lambda (y)
+ (declare (optimize speed))
+ (let ((x (the (cons fixnum fixnum) (cons 1 2))))
+ (declare (type (cons t fixnum) x))
+ (rplaca x y)
+ (+ (car x) (cdr x))))))
+ (f2 (compile nil
+ `(lambda (y)
+ (declare (optimize speed))
+ (let ((x (the (cons fixnum fixnum) (cons 1 2))))
+ (setf (cdr x) y)
+ (+ (car x) (cdr x)))))))
+ (flet ((test-error (e value)
+ (assert (typep e 'type-error))
+ (assert (eq 'number (type-error-expected-type e)))
+ (assert (eq value (type-error-datum e)))))
+ (let ((v1 "foo")
+ (v2 "bar"))
+ (multiple-value-bind (res err) (ignore-errors (funcall f1 v1))
+ (assert (not res))
+ (test-error err v1))
+ (multiple-value-bind (res err) (ignore-errors (funcall f2 v2))
+ (assert (not res))
+ (test-error err v2))))))
+
+(with-test (:name :array-dimension-derivation-conservative)
+ (let ((f (compile nil
+ `(lambda (x)
+ (declare (optimize speed))
+ (declare (type (array * (4 4)) x))
+ (let ((y x))
+ (setq x (make-array '(4 4)))
+ (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)))))))