From: Paul Khuong <pvk@pvk.ca>
Date: Mon, 8 Jul 2013 21:05:26 +0000 (-0400)
Subject: Handle unbounded integer types in INTEGER-TYPE-NUMERIC-BOUNDS
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=220651c01541b357cfb478e0989aae646d953c51;p=sbcl.git

Handle unbounded integer types in INTEGER-TYPE-NUMERIC-BOUNDS

If any of the integer type in the union lack upper or lower bounds,
immediately abort with unknown bounds (rather than taking the MIN
of NIL and an integer).

Thanks to pfdietz for his random testing.

Fixes lp#1199127.
---

diff --git a/NEWS b/NEWS
index 25ec549..e4dc0a9 100644
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.9:
   * enhancement: ASDF has been updated to 3.0.2.
+  * bug fix: Compiling potential modularic arithmetic forms does not cause type
+    errors when some integer types lack lower or upper bounds. (lp#1199127)
 
 changes in sbcl-1.1.9 relative to sbcl-1.1.8:
   * new feature: the contrib SB-GMP links with libgmp at runtime to speed
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 221eaf0..18f7301 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3075,6 +3075,8 @@
            (return (values nil nil)))
          (let ((this-low (numeric-type-low type))
                (this-high (numeric-type-high type)))
+           (unless (and this-low this-high)
+             (return (values nil nil)))
            (setf low  (min this-low  (or low  this-low))
                  high (max this-high (or high this-high)))))))))
 
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 48d413d..d3588af 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1,3 +1,4 @@
+
 ;;;; various compiler tests without side effects
 
 ;;;; This software is part of the SBCL system. See the README file for
@@ -4668,3 +4669,16 @@
   (handler-case (eval '(cosh 90))
     (floating-point-overflow ()
       t)))
+
+;; unbounded integer types could break integer arithmetic.
+(with-test (:name :bug-1199127)
+  (compile nil `(lambda (b)
+                  (declare (type (integer -1225923945345 -832450738898) b))
+                  (declare (optimize (speed 3) (space 3) (safety 2)
+                                     (debug 0) (compilation-speed 1)))
+                  (loop for lv1 below 3
+                        sum (logorc2
+                             (if (>= 0 lv1)
+                                 (ash b (min 25 lv1))
+                                 0)
+                             -2)))))