X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=5f24fbeeab2afa4b2e5c790f9c27ba2ae583dda8;hb=86d50ba6266c823eedd444c4e1c5a55e9dc7f46a;hp=7b2e915455f6cea64386b13c322d6c853f908862;hpb=26627f70af3ede3610e4092175965e0250456a4d;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 7b2e915..5f24fbe 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2231,15 +2231,16 @@
                (logand most-positive-fixnum (* x most-positive-fixnum))))
 
 ;;; bug 256.b
-(assert (let (warned-p)
+(with-test (:name :propagate-type-through-error-and-binding)
+  (assert (let (warned-p)
             (handler-bind ((warning (lambda (w) (setf warned-p t))))
               (compile nil
-                         '(lambda (x)
-                           (list (let ((y (the real x)))
-                                   (unless (floatp y) (error ""))
-                                   y)
-                                 (integer-length x)))))
-            warned-p))
+                       '(lambda (x)
+                         (list (let ((y (the real x)))
+                                 (unless (floatp y) (error ""))
+                                 y)
+                          (integer-length x)))))
+            warned-p)))
 
 ;; Dead / in safe code
 (with-test (:name :safe-dead-/)
@@ -3070,20 +3071,6 @@
             (assert (eql x (funcall fun i)))
             (assert (eql (- x) (funcall fun i))))))))
 
-(with-test (:name (load-time-value :type-derivation))
-  (flet ((test (type form value-cell-p)
-           (let ((derived (funcall (compile
-                                    nil
-                                    `(lambda ()
-                                       (ctu:compiler-derived-type
-                                        (load-time-value ,form)))))))
-             (unless (equal type derived)
-              (error "wanted ~S, got ~S" type derived)))))
-    (let ((* 10))
-      (test '(integer 11 11) '(+ * 1) nil))
-    (let ((* "fooo"))
-      (test '(integer 4 4) '(length *) t))))
-
 (with-test (:name :float-division-using-exact-reciprocal)
   (flet ((test (lambda-form arg res &key (check-insts t))
            (let* ((fun (compile nil lambda-form))
@@ -3926,3 +3913,63 @@
     (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-486812 single-float))
+  (compile nil `(lambda ()
+                  (sb-kernel:make-single-float -1))))
+
+(with-test (:name (:bug-486812 double-float))
+  (compile nil `(lambda ()
+                  (sb-kernel:make-double-float -1 0))))
+
+(with-test (:name :bug-729765)
+  (compile nil `(lambda (a b)
+                  (declare ((integer 1 1) a)
+                           ((integer 0 1) b)
+                           (optimize debug))
+                  (lambda () (< b a)))))
+
+;; Actually tests the assembly of RIP-relative operands to comparison
+;; functions (one of the few x86 instructions that have extra bytes
+;; *after* the mem operand's effective address, resulting in a wrong
+;; offset).
+(with-test (:name :cmpps)
+  (let ((foo (compile nil `(lambda (x)
+                             (= #C(2.0 3.0) (the (complex single-float) x))))))
+    (assert (funcall foo #C(2.0 3.0)))
+    (assert (not (funcall foo #C(1.0 2.0))))))
+
+(with-test (:name :cmppd)
+  (let ((foo (compile nil `(lambda (x)
+                             (= #C(2d0 3d0) (the (complex double-float) x))))))
+    (assert (funcall foo #C(2d0 3d0)))
+    (assert (not (funcall foo #C(1d0 2d0))))))
+
+(with-test (:name :lvar-externally-checkable-type-nil)
+  ;; Used to signal a BUG during compilation.
+  (let ((fun (compile nil `(lambda (a) (parse-integer "12321321" (the (member :start) a) 1)))))
+    (multiple-value-bind (i p) (funcall fun :start)
+      (assert (= 2321321 i))
+      (assert (= 8 p)))
+    (multiple-value-bind (i e) (ignore-errors (funcall fun :end))
+      (assert (not i))
+      (assert (typep e 'type-error)))))
+
+(with-test (:name :simple-type-error-in-bound-propagation-a)
+  (compile nil `(lambda (i)
+                  (declare (unsigned-byte i))
+                  (expt 10 (expt 7 (- 2 i))))))
+
+(with-test (:name :simple-type-error-in-bound-propagation-b)
+  (assert (equal `(FUNCTION (UNSIGNED-BYTE)
+                            (VALUES (SINGLE-FLOAT -1F0 1F0) &OPTIONAL))
+                 (sb-kernel:%simple-fun-type
+                  (compile nil `(lambda (i)
+                                  (declare (unsigned-byte i))
+                                  (cos (expt 10 (+ 4096 i)))))))))
+
+(with-test (:name :fixed-%more-arg-values)
+  (let ((fun (compile nil `(lambda (&rest rest)
+                             (declare (optimize (safety 0)))
+                             (apply #'cons rest)))))
+    (assert (equal '(car . cdr) (funcall fun 'car 'cdr)))))