X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=1d17955ee31c2d7a924b0e6466c8e7f6177fb1ff;hb=e855e0537e05f315d26cf8778353a3be02ee760b;hp=f1431f1d71bd148bb99e8c0428ac99279d7d0cf0;hpb=8f4ef01b8c9930d7dd0a56a96845a6d84ca5774d;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index f1431f1..1d17955 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -606,6 +606,35 @@
                   (+ 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 
@@ -614,3 +643,94 @@
 				(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))
+
+;;; bug in modular arithmetic and type specifiers
+(assert (= (funcall (compile nil (lambda (x) (logand x x 0)))
+		    -1)
+	   0))
+
+;;; MISC.99 from Paul Dietz' random tester: FAST-ASH-MOD32-C VOP
+;;; produced wrong result for shift >=32 on X86
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (mask-field (byte 18 2) (ash a 77))))
+              57132532)))
+
+;;; MISC.101 and MISC.103: FLUSH-DEST did not mark the USE's block for
+;;; type check regeneration
+(assert (eql (funcall
+              (compile nil '(lambda (a c)
+                             (declare (type (integer 185501219873 303014665162) a))
+                             (declare (type (integer -160758 255724) c))
+                             (declare (optimize (speed 3)))
+                             (let ((v8
+                                    (- -554046873252388011622614991634432
+                                       (ignore-errors c)
+                                       (unwind-protect 2791485))))
+                               (max (ignore-errors a)
+                                    (let ((v6 (- v8 (restart-case 980))))
+                                      (min v8 v6))))))
+              259448422916 173715)
+             259448422916))
+(assert (eql (funcall
+              (compile nil '(lambda (a b)
+                             (min -80
+                              (abs
+                               (ignore-errors
+                                 (+
+                                  (logeqv b
+                                          (block b6
+                                            (return-from b6
+                                              (load-time-value -6876935))))
+                                  (if (logbitp 1 a) b (setq a -1522022182249))))))))
+              -1802767029877 -12374959963)
+             -80))