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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 433b520..ad1853d 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -562,3 +562,131 @@
                     (fun (compile nil src))
                     (result (1+ (funcall (eval #'*) x real-zero))))
                (assert (eql result (funcall fun x)))))))
+
+;;; (SIGNED-BYTE 1) [ returned from the logxor derive-type optimizer ]
+;;; wasn't recognized as a good type specifier.
+(let ((fun (lambda (x y)
+	     (declare (type (integer -1 0) x y) (optimize speed))
+	     (logxor x y))))
+  (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))
+
+;;; 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))