From 31f691c9565941b4c04309b16a871860246c29e1 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Mon, 24 Nov 2014 11:31:11 -0800
Subject: [PATCH] Fix error in computation (log number base) where one of the
 args is a double-double.

 * src/code/irrat.lisp:
   * For the following two cases, cmucl generated an error instead of
     computing the log
     * Base is a double-double but number is not.
     * Number is a double-double but base is not.
 * tests/irrat.lisp:
   * Add some tests for log2 and log10.
---
 src/code/irrat.lisp | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 8ddd41381..fa891427e 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -669,7 +669,11 @@
 		    (foreach integer single-float))
 		   (float (log2 (float number 1d0)) 1f0))
 		  ((single-float double-float)
-		   (log2 (float number 1d0)))))
+		   (log2 (float number 1d0)))
+		  #+double-double
+		  (((foreach integer single-float double-float)
+		    ext:double-double-float)
+		   (log2 (float number 1w0) base))))
 	       ((and (= base 10)
 		     (floatp number)
 		     #+double-double
@@ -687,7 +691,13 @@
 		    (foreach single-float integer))
 		   (float (%log10 (float number 1d0)) 1f0))
 		  ((single-float double-float)
-		   (%log10 (float number 1d0)))))
+		   (%log10 (float number 1d0)))
+		  #+double-double
+		  (((foreach integer single-float double-float)
+		    ext:double-double-float)
+		   ;; This could be more accurate!
+		   (/ (log (float number 1w0))
+		      (log 10w0)))))
 	       (t
 		;; CLHS 12.1.4.1 says
 		;;
@@ -729,11 +739,14 @@
 		  #+double-double
 		  ((double-double-float
 		    (foreach fixnum bignum ratio))
+		   ;; Use log2 in case the base is so large that it
+		   ;; won't fit in a float.
 		   (/ (log2 number 1w0) (log2 base 1w0)))
 		  #+double-double
 		  ((double-double-float
 		    (foreach double-double-float double-float single-float))
-		   (/ (log number) (log (coerce base 'double-double-float))))
+		   (/ (log number)
+		      (log (coerce base 'double-double-float))))
 		  #+double-double
 		  (((foreach fixnum bignum ratio)
 		    double-double-float)
-- 
GitLab