+
+(with-test (:name :bug-767959)
+ ;; This used to signal an error.
+ (compile nil `(lambda ()
+ (declare (optimize sb-c:store-coverage-data))
+ (assoc
+ nil
+ '((:ordinary . ordinary-lambda-list))))))
+
+(with-test (:name :member-on-long-constant-list)
+ ;; This used to blow stack with a sufficiently long list.
+ (let ((cycle (list t)))
+ (nconc cycle cycle)
+ (compile nil `(lambda (x)
+ (member x ',cycle)))))
+
+(with-test (:name :bug-722734)
+ (assert (raises-error?
+ (funcall (compile
+ nil
+ '(lambda ()
+ (eql (make-array 6)
+ (list unbound-variable-1 unbound-variable-2))))))))
+
+(with-test (:name :bug-771673)
+ (assert (equal `(the foo bar) (macroexpand `(truly-the foo bar))))
+ ;; Make sure the compiler doesn't use THE, and check that setf-expansions
+ ;; work.
+ (let ((f (compile nil `(lambda (x y)
+ (setf (truly-the fixnum (car x)) y)))))
+ (let* ((cell (cons t t)))
+ (funcall f cell :ok)
+ (assert (equal '(:ok . t) cell)))))
+
+(with-test (:name (:bug-793771 +))
+ (let ((f (compile nil `(lambda (x y)
+ (declare (type (single-float 2.0) x)
+ (type (single-float (0.0)) y))
+ (+ x y)))))
+ (assert (equal `(function ((single-float 2.0) (single-float (0.0)))
+ (values (single-float 2.0) &optional))
+ (sb-kernel:%simple-fun-type f)))))
+
+(with-test (:name (:bug-793771 -))
+ (let ((f (compile nil `(lambda (x y)
+ (declare (type (single-float * 2.0) x)
+ (type (single-float (0.0)) y))
+ (- x y)))))
+ (assert (equal `(function ((single-float * 2.0) (single-float (0.0)))
+ (values (single-float * 2.0) &optional))
+ (sb-kernel:%simple-fun-type f)))))
+
+(with-test (:name (:bug-793771 *))
+ (let ((f (compile nil `(lambda (x)
+ (declare (type (single-float (0.0)) x))
+ (* x 0.1)))))
+ (assert (equal `(function ((single-float (0.0)))
+ (values (or (member 0.0) (single-float (0.0))) &optional))
+ (sb-kernel:%simple-fun-type f)))))
+
+(with-test (:name (:bug-793771 /))
+ (let ((f (compile nil `(lambda (x)
+ (declare (type (single-float (0.0)) x))
+ (/ x 3.0)))))
+ (assert (equal `(function ((single-float (0.0)))
+ (values (or (member 0.0) (single-float (0.0))) &optional))
+ (sb-kernel:%simple-fun-type f)))))