X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=f2cba5fa3723b04e8ca4415713fe7ae5e811b652;hb=9dcde13065f57a8ad55681575a298fbcac66381b;hp=165c17bf9f63261113a59dc18ac62671051f76cf;hpb=d95f1e6476aa63695e018a7769a1ae9e002fca36;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 165c17b..f2cba5f 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2691,6 +2691,11 @@
                        t)
               t)))
 
+(with-test (:name :regression-1.0.24.37)
+  (compile nil '(lambda (&key (test (constantly t)))
+                 (when (funcall test)
+                   :quux))))
+
 ;;; Attempt to test a decent cross section of conditions
 ;;; and values types to move conditionally.
 (macrolet
@@ -2829,3 +2834,40 @@
       (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))))))