X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=ad1853d8e07c75eec98e3756352d7e9e47c6362a;hb=d3c56c291d4d4eff8c3ec234d5ed904fe5b55df4;hp=c1cb8f6c1b3c76f56bad249c70b3a05bdf8c3ef2;hpb=b314841f7aa9e9236e8d5097a34f4f28349b408b;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index c1cb8f6..ad1853d 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -587,7 +587,106 @@
 ;;; 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-bind ((arithmetic-error #'abort))
+(handler-case (/ 1.0 0.0)
   ;; provoke an exception
-  (/ 1.0 0.0))
+  (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))
+
+;;; bug found by WHN and pfdietz: compiler failure while referencing
+;;; an entry point inside a deleted lambda
+(compile nil '(lambda ()
+               (let (r3533)
+                 (flet ((bbfn ()
+                          (setf r3533
+                                (progn
+                                  (flet ((truly (fn bbd)
+                                           (let (r3534)
+                                             (let ((p3537 nil))
+                                               (unwind-protect
+                                                    (multiple-value-prog1
+                                                        (progn
+                                                          (setf r3534
+                                                                (progn
+                                                                  (bubf bbd t)
+                                                                  (flet ((c-3536 ()
+                                                                           (funcall fn)))
+                                                                    (cdec #'c-3536
+                                                                          (vector bbd))))))
+                                                      (setf p3537 t))
+                                                 (unless p3537
+                                                   (error "j"))))
+                                             r3534))
+                                         (c (pd) (pdc pd)))
+                                    (let ((a (smock a))
+                                          (b (smock b))
+                                          (b (smock c)))))))))
+                   (wum #'bbfn "hc3" (list)))
+                 r3533)))
+(compile nil '(lambda () (flet ((%f () (unwind-protect nil))) nil)))
+
+;;; the strength reduction of constant multiplication used (before
+;;; sbcl-0.8.4.x) to lie to the compiler.  This meant that, under
+;;; certain circumstances, the compiler would derive that a perfectly
+;;; reasonable multiplication never returned, causing chaos.  Fixed by
+;;; explicitly doing modular arithmetic, and relying on the backends
+;;; being smart.
+(assert (= (funcall 
+	    (compile nil 
+		     '(lambda (x)
+			(declare (type (integer 178956970 178956970) x)
+				 (optimize speed)) 
+			(* x 24)))
+	    178956970)
+	   4294967280))