1.0.4.40: small fixes

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 4ab5af3..ff91c66 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1375,8 +1375,12 @@
 (handler-case (compile nil '(lambda (x)
                              (declare (optimize (speed 3) (safety 0)))
                              (the double-float (sqrt (the double-float x)))))
-  (sb-ext:compiler-note ()
-    (error "Compiler does not trust result type assertion.")))
+  (sb-ext:compiler-note (c)
+    ;; Ignore the note for the float -> pointer conversion of the
+    ;; return value.
+    (unless (string= (car (last (sb-c::simple-condition-format-arguments c)))
+                     "<return value>")
+      (error "Compiler does not trust result type assertion."))))
 
 (let ((f (compile nil '(lambda (x)
                         (declare (optimize speed (safety 0)))
@@ -1901,14 +1905,15 @@
     (compile nil '(lambda (x)
                    (declare (optimize (speed 3)))
                    (1+ x))))
-  ;; forced-to-do GENERIC-+, etc
-  (assert (> count0 0))
+  ;; forced-to-do GENERIC-+, etc, possible word -> bignum conversion note
+  (assert (> count0 1))
   (handler-bind ((sb-ext:compiler-note (lambda (c) (incf count1))))
     (compile nil '(lambda (x)
                    (declare (optimize (speed 3)))
                    (check-type x fixnum)
                    (1+ x))))
-  (assert (= count1 0)))
+  ;; Only the posssible word -> bignum conversion note
+  (assert (= count1 1)))
 
 ;;; Up to 0.9.8.22 x86-64 had broken return value handling in the
 ;;; %SET-SAP-REF-DOUBLE/SINGLE VOPs.
@@ -2038,6 +2043,30 @@
       (compiler-note () (throw :note nil)))
     (error "Unreachable code undetected.")))
 
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-var-1))
+  (catch :note
+    (handler-case
+        (compile nil '(lambda (x y)
+                        (when (typep y 'fixnum)
+                          (when (eql x y)
+                            (unless (typep x 'fixnum)
+                              (error "This is unreachable"))
+                            (setq y nil)))))
+      (compiler-note () (throw :note nil)))
+    (error "Unreachable code undetected.")))
+
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-var-2))
+  (catch :note
+    (handler-case
+        (compile nil '(lambda (x y)
+                        (when (typep y 'fixnum)
+                          (when (eql y x)
+                            (unless (typep x 'fixnum)
+                              (error "This is unreachable"))
+                            (setq y nil)))))
+      (compiler-note () (throw :note nil)))
+    (error "Unreachable code undetected.")))
+
 ;; Reported by John Wiseman, sbcl-devel
 ;; Subject: [Sbcl-devel] float type derivation bug?
 ;; Date: Tue, 4 Apr 2006 15:28:15 -0700
@@ -2146,6 +2175,43 @@
 ;;; LET* + VALUES declaration: while the declaration is a non-standard
 ;;; and possibly a non-conforming extension, as long as we do support
 ;;; it, we might as well get it right.
-;;; 
+;;;
 ;;; Bug reported by Kaersten Poeck on sbcl-devel 20061023.
 (compile nil '(lambda () (let* () (declare (values list)))))
+
+
+;;; test for some problems with too large immediates in x86-64 modular
+;;; arithmetic vops
+(compile nil '(lambda (x) (declare (fixnum x))
+               (logand most-positive-fixnum (logxor x most-positive-fixnum))))
+
+(compile nil '(lambda (x) (declare (fixnum x))
+               (logand most-positive-fixnum (+ x most-positive-fixnum))))
+
+(compile nil '(lambda (x) (declare (fixnum x))
+               (logand most-positive-fixnum (* x most-positive-fixnum))))
+
+;;; bug 256.b
+(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))
+
+;; Dead / in safe code
+(with-test (:name :safe-dead-/)
+  (assert (eq :error
+              (handler-case
+                  (funcall (compile nil
+                                    '(lambda (x y)
+                                      (declare (optimize (safety 3)))
+                                      (/ x y)
+                                      (+ x y)))
+                           1
+                           0)
+                (division-by-zero ()
+                  :error)))))