From 4f102592a1c122f17231563671930456c7c85f5c Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 11 Sep 2003 11:27:56 +0000 Subject: [PATCH] 0.8.3.51: Fix (LCM 0 0) --- NEWS | 2 ++ src/code/numbers.lisp | 21 ++++++++++++++------- tests/arith.pure.lisp | 1 + version.lisp-expr | 2 +- 4 files changed, 18 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index a6c9ad7..af2dbaf 100644 --- a/NEWS +++ b/NEWS @@ -2048,6 +2048,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: upper bounding index of a substring in case :JUNK-ALLOWED NIL. ** PARSE-INTEGER returned an incorrect index being applied to a displaced string. + ** LCM with two arguments of 0 returns 0 rather than signalling + DIVISION-BY-ZERO. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index c2a1a6b..f5cbddf 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -1263,13 +1263,20 @@ (defun two-arg-lcm (n m) (declare (integer n m)) - (let ((m (abs m)) - (n (abs n))) - (multiple-value-bind (max min) - (if (> m n) - (values m n) - (values n m)) - (* (truncate max (gcd n m)) min)))) + (if (or (zerop n) (zerop m)) + 0 + ;; KLUDGE: I'm going to assume that it was written this way + ;; originally for a reason. However, this is a somewhat + ;; complicated way of writing the algorithm in the CLHS page for + ;; LCM, and I don't know why. To be investigated. -- CSR, + ;; 2003-09-11 + (let ((m (abs m)) + (n (abs n))) + (multiple-value-bind (max min) + (if (> m n) + (values m n) + (values n m)) + (* (truncate max (gcd n m)) min))))) ;;; Do the GCD of two integer arguments. With fixnum arguments, we use the ;;; binary GCD algorithm from Knuth's seminumerical algorithms (slightly diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index 00ff6af..1f26fcc 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -110,6 +110,7 @@ (assert (= (gcd 0 x) (abs x)))) ;;; LCM returns a non-negative number (assert (= (lcm 4 -10) 20)) +(assert (= (lcm 0 0) 0)) ;;; PPC bignum arithmetic bug: (multiple-value-bind (quo rem) diff --git a/version.lisp-expr b/version.lisp-expr index 60fbb52..cbc4c42 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.3.50" +"0.8.3.51" -- 1.7.10.4