master: Handle division by zero when deriving (/ integer integer)
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 52250de6b879671adca0e1986fef4e4910064ce2 (commit)
from 9c4550e399320f521f13372b5eacf65508e60e8f (commit)
- Log -----------------------------------------------------------------
commit 52250de6b879671adca0e1986fef4e4910064ce2
Author: Stas Boukarev <[email protected]>
Date: Wed Apr 8 21:56:39 2026 +0300
Handle division by zero when deriving (/ integer integer)
---
src/compiler/srctran.lisp | 60 ++++++++++++++++++++++++++++-------------------
tests/arith-2.pure.lisp | 8 ++++++-
2 files changed, 43 insertions(+), 25 deletions(-)
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 0f7113929..c39bde4ec 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1488,7 +1488,11 @@
(let* ((zero (intervals-zero top bot))
(top-range (interval-range-info top zero))
(bot-range (interval-range-info bot zero)))
- (cond ((null bot-range)
+ (cond ((and integer
+ (eql (interval-low bot) 0)
+ (eql (interval-high bot) 0))
+ nil)
+ ((null bot-range)
(if integer
(multiple-value-bind (bot- bot+) (interval-split zero bot t t)
(let ((r- (interval-div top bot-))
@@ -1524,10 +1528,10 @@
(make-interval
:low (bound-div (interval-low top) (interval-high bot) t)
:high (let ((top-high (interval-high top)))
- (if (and (numberp top-high)
- (zerop top-high))
- zero
- (bound-div top-high (interval-low bot) nil)))))
+ (if (and (numberp top-high)
+ (zerop top-high))
+ zero
+ (bound-div top-high (interval-low bot) nil)))))
(t
(bug "excluded case in INTERVAL-DIV")))))))
(interval-div top bot)))
@@ -2120,17 +2124,19 @@
(interval-div x-interval y-interval
(and (memq (numeric-type-class x) '(integer rational))
y-integerp)))))
- (cond ((consp result)
- (type-union (make-numeric-type :class (numeric-type-class result-type)
- :format (numeric-type-format result-type)
- :low (interval-low (first result))
- :high (interval-high (first result))
- :normalize-zeros nil)
- (make-numeric-type :class (numeric-type-class result-type)
- :format (numeric-type-format result-type)
- :low (interval-low (second result))
- :high (interval-high (second result))
- :normalize-zeros nil)))
+ (cond ((null result)
+ *empty-type*)
+ ((consp result)
+ (type-union (make-numeric-type :class (numeric-type-class result-type)
+ :format (numeric-type-format result-type)
+ :low (interval-low (first result))
+ :high (interval-high (first result))
+ :normalize-zeros nil)
+ (make-numeric-type :class (numeric-type-class result-type)
+ :format (numeric-type-format result-type)
+ :low (interval-low (second result))
+ :high (interval-high (second result))
+ :normalize-zeros nil)))
(t
;; If the result type is a float, we need to be sure to coerce
;; the bounds into the correct type.
@@ -2384,10 +2390,13 @@
:low (interval-low quot)
:high (interval-high quot)
:normalize-zeros nil))))
- (if (listp div)
- (type-union (make-quot (first div))
- (make-quot (second div)))
- (make-quot div)))))
+ (cond ((null div)
+ *empty-type*)
+ ((listp div)
+ (type-union (make-quot (first div))
+ (make-quot (second div))))
+ (t
+ (make-quot div))))))
(t
(multiple-value-bind (quot conservative)
(if (and (member (interval-high divisor-interval) '(1 1f0 1d0))
@@ -2631,10 +2640,13 @@
:low (interval-low quot)
:high (interval-high quot)
:normalize-zeros nil))))
- (if (listp div)
- (type-union (make-quot (first div))
- (make-quot (second div)))
- (make-quot div)))))
+ (cond ((null div)
+ *empty-type*)
+ ((listp div)
+ (type-union (make-quot (first div))
+ (make-quot (second div))))
+ (t
+ (make-quot div))))))
;; Compute type of remainder.
(defun ,r-aux (number-type divisor-type &optional same)
(declare (ignore same))
diff --git a/tests/arith-2.pure.lisp b/tests/arith-2.pure.lisp
index df8a52802..7c6ee9bb0 100644
--- a/tests/arith-2.pure.lisp
+++ b/tests/arith-2.pure.lisp
@@ -2473,7 +2473,13 @@
(declare ((integer -9 9) n)
((and integer (not (member 1 -1))) x))
(truncate n x))
- (values (integer -4 4) (integer -9 9) &optional)))
+ (values (integer -4 4) (integer -9 9) &optional))
+ (assert-type
+ (lambda (n x)
+ (declare ((integer -9 9) n)
+ ((and integer (not (member 1 -1))) x))
+ (/ n x))
+ (rational -9/2 9/2)))
(with-test (:name :floor-by-integer-type)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL