Insert explicit cut to width when needed

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index d3588af..9e955c1 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4682,3 +4682,40 @@
                                  (ash b (min 25 lv1))
                                  0)
                              -2)))))
+
+;; non-trivial modular arithmetic operations would evaluate to wider results
+;; than expected, and never be cut to the right final bitwidth.
+(with-test (:name :bug-1199428-1)
+  (let ((f1 (compile nil `(lambda (a c)
+                            (declare (type (integer -2 1217810089) a))
+                            (declare (type (integer -6895591104928 -561736648588) c))
+                            (declare (optimize (speed 2) (space 0) (safety 2) (debug 0)
+                                               (compilation-speed 3)))
+                            (logandc1 (gcd c)
+                                      (+ (- a c)
+                                         (loop for lv2 below 1 count t))))))
+        (f2 (compile nil `(lambda (a c)
+                            (declare (notinline - + gcd logandc1))
+                            (declare (optimize (speed 1) (space 1) (safety 0) (debug 1)
+                                               (compilation-speed 3)))
+                            (logandc1 (gcd c)
+                                      (+ (- a c)
+                                         (loop for lv2 below 1 count t)))))))
+    (let ((a 530436387)
+          (c -4890629672277))
+      (assert (eql (funcall f1 a c)
+                   (funcall f2 a c))))))
+
+(with-test (:name :bug-1199428-2)
+  (let ((f1 (compile nil `(lambda (a b)
+                            (declare (type (integer -1869232508 -6939151) a))
+                            (declare (type (integer -11466348357 -2645644006) b))
+                            (declare (optimize (speed 1) (space 0) (safety 2) (debug 2)
+                                               (compilation-speed 2)))
+                            (logand (lognand a -6) (* b -502823994)))))
+        (f2 (compile nil `(lambda (a b)
+                            (logand (lognand a -6) (* b -502823994))))))
+    (let ((a -1491588365)
+          (b -3745511761))
+      (assert (eql (funcall f1 a b)
+                   (funcall f2 a b))))))