0.8.4.2:

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index f9c418f..9776ae2 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -571,3 +571,75 @@
   (assert (= (funcall fun 0 0) 0))
   (assert (= (funcall fun 0 -1) -1))
   (assert (= (funcall fun -1 -1) 0)))
+
+;;; from PFD's torture test, triggering a bug in our effective address
+;;; treatment.
+(compile
+ nil
+ `(lambda (a b)
+    (declare (type (integer 8 22337) b))
+    (logandc2
+     (logandc2
+      (* (logandc1 (max -29303 b) 4) b)
+      (abs (logorc1 (+ (logandc1 -11 b) 2607688420) -31153924)))
+     (logeqv (max a 0) b))))
+
+;;; Alpha floating point modes weren't being reset after an exception,
+;;; leading to an exception on the second compile, below.
+(compile nil '(lambda (x y) (declare (type (double-float 0.0d0) x y)) (/ x y)))
+(handler-case (/ 1.0 0.0)
+  ;; provoke an exception
+  (arithmetic-error ()))
+(compile nil '(lambda (x y) (declare (type (double-float 0.0d0) x y)) (/ x y)))
+
+;;; bug reported by Paul Dietz: component last block does not have
+;;; start ctran
+(compile nil
+         '(lambda ()
+           (declare (notinline + logand)
+            (optimize (speed 0)))
+           (LOGAND
+            (BLOCK B5
+              (FLET ((%F1 ()
+                       (RETURN-FROM B5 -220)))
+                (LET ((V7 (%F1)))
+                  (+ 359749 35728422))))
+            -24076)))
+
+;;; bug 294 reported by Paul Dietz: miscompilation of REM and MOD
+(assert (= (funcall (compile nil `(lambda (b)
+                                    (declare (optimize (speed 3))
+                                             (type (integer 2 152044363) b))
+                                    (rem b (min -16 0))))
+                    108251912)
+           8))
+
+(assert (= (funcall (compile nil `(lambda (c)
+                                    (declare (optimize (speed 3))
+                                             (type (integer 23062188 149459656) c))
+                                    (mod c (min -2 0))))
+                    95019853)
+           -1))
+
+;;; bug reported by Paul Dietz: block splitting inside FLUSH-DEAD-CODE
+(compile nil
+         '(LAMBDA (A B C)
+           (BLOCK B6
+             (LOGEQV (REM C -6758)
+                     (REM B (MAX 44 (RETURN-FROM B6 A)))))))
+
+(compile nil '(lambda ()
+               (block nil
+                 (flet ((foo (x y) (if (> x y) (print x) (print y))))
+                   (foo 1 2)
+                   (bar)
+                   (foo (return 14) 2)))))
+
+;;; bug in Alpha backend: not enough sanity checking of arguments to
+;;; instructions
+(assert (= (funcall (compile nil 
+                            '(lambda (x) 
+                               (declare (fixnum x)) 
+                               (ash x -257)))
+                   1024)
+          0))