1.0.43.29: fix OVERAGER-CHARACTER-BUFFERING test-case

[sbcl.git] / tests / compiler.pure.lisp

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 531acc1..5435c43 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2676,6 +2676,14 @@
     (assert (eq 'list type))
     (assert derivedp)))
 
+(with-test (:name :rest-list-type-derivation2)
+  (multiple-value-bind (type derivedp)
+      (funcall (funcall (compile nil `(lambda ()
+                                        (lambda (&rest args)
+                                          (ctu:compiler-derived-type args))))))
+    (assert (eq 'list type))
+    (assert derivedp)))
+
 (with-test (:name :base-char-typep-elimination)
   (assert (eq (funcall (lambda (ch)
                          (declare (type base-char ch) (optimize (speed 3) (safety 0)))
@@ -3558,3 +3566,27 @@
                                   (list (vector-push-extend (svref x 0) x))))
                 ((and warning (not style-warning)) ()
                   :warning)))))
+
+(with-test (:name :bug-646796)
+  (assert 42
+          (funcall
+           (compile nil
+                    `(lambda ()
+                       (load-time-value (the (values fixnum) 42)))))))
+
+(with-test (:name :bug-654289)
+  (let* ((big (labels ((make-tree (n acc)
+                         (cond ((zerop n) acc)
+                               (t (make-tree (1- n) (cons acc acc))))))
+                (make-tree 10000 nil)))
+         (small '((1) (2) (3)))
+         (t0 (get-internal-run-time))
+         (f1 (compile nil `(lambda (x) (eq x (quote ,big)))))
+         (t1 (get-internal-run-time))
+         (f2 (compile nil `(lambda (x) (eq x (quote ,small)))))
+         (t2 (get-internal-run-time)))
+    (assert (funcall f1 big))
+    (assert (funcall f2 small))
+    ;; Compile time should not explode just because there's a big constant
+    ;; object in the source.
+    (assert (> 10 (abs (- (- t1 t0) (- t2 t1)))))))