From a932491bb20a7e2a05cce1bd142870f2a6edfcad Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Mon, 24 Nov 2014 13:39:37 -0800
Subject: [PATCH] Add tests for log2 and log10.

---
 tests/irrat.lisp | 88 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 88 insertions(+)
 create mode 100644 tests/irrat.lisp

diff --git a/tests/irrat.lisp b/tests/irrat.lisp
new file mode 100644
index 000000000..f1913d379
--- /dev/null
+++ b/tests/irrat.lisp
@@ -0,0 +1,88 @@
+;; Tests of special irrational functions
+
+(defpackage :irrat-tests
+  (:use :cl :lisp-unit))
+
+(in-package "IRRAT-TESTS")
+
+;; This tests that log base 2 returns the correct value and the
+;; correct type.
+(define-test log2
+  (dolist (number '(4 4f0 4d0 #+double-double 4w0))
+    (dolist (base '(2 2f0 2d0 #+double-double 2w0))
+      ;; This tests that log returns the correct value and the correct type.
+      (let* ((result (log number base))
+	     (true-type (etypecase number
+			  ((or integer single-float)
+			   (etypecase base
+			     ((or integer single-float) 'single-float)
+			     (double-float 'double-float)
+			     #+double-double
+			     (ext:double-double-float 'ext:double-double-float)))
+			  (double-float
+			   (etypecase base
+			     ((or integer single-float double-float)
+			      'double-float)
+			     #+double-double
+			     (ext:double-double-float 'ext:double-double-float)))
+			  #+double-double
+			  (ext:double-double-float
+			   'ext:double-double-float))))
+	(assert-equal (coerce 2 true-type) result
+		      number base)
+	(assert-true (typep result true-type)
+		     result true-type)))))
+
+;; This tests that log base 10 returns the correct value and the
+;; correct type.
+(define-test log10
+  (dolist (number '(100 100f0 100d0 #+double-double 100w0))
+    (dolist (base '(10 10f0 10d0 #+double-double 10w0))
+      ;; This tests that log returns the correct value and the correct type.
+      (let* ((result (log number base))
+	     (relerr (/ (abs (- result 2)) 2)))
+	;; Figure out the expected type of the result and the maximum
+	;; allowed relative error.  It turns out that for these test
+	;; cases, the result is exactly 2 except when the result type
+	;; is a double-double-float.  In that case, there is a slight
+	;; error for (log 100w0 10).
+	(multiple-value-bind (true-type allowed-error)
+	    (etypecase number
+	      ((or integer single-float)
+	       (etypecase base
+		 ((or integer single-float)
+		  (values 'single-float 0))
+		 (double-float
+		  (values 'double-float 0))
+		 #+double-double
+		 (ext:double-double-float
+		  (values 'ext:double-double-float
+			  7.5d-33))))
+	      (double-float
+	       (etypecase base
+		 ((or integer single-float double-float)
+		  (values 'double-float 0))
+		 #+double-double
+		 (ext:double-double-float
+		  (values 'ext:double-double-float
+			  7.5d-33))))
+	      #+double-double
+	      (ext:double-double-float
+	       (values 'ext:double-double-float
+		       7.5d-33)))
+	  (assert-true (<= relerr allowed-error)
+		       number base result relerr allowed-error)
+	  (assert-true (typep result true-type)
+		       number baes result true-type))))))
+
+(define-test dd-log2
+  ;; Verify that for x = 10^k for k = 1 to 300 that (kernel::dd-%log2
+  ;; x) is close to the expected value. Previously, a bug caused
+  ;; (kernel::dd-%log2 100w0) to give 6.1699... instead of 6.64385.
+  (loop for k from 1 below 300
+	and x = (expt 10 k)
+	and y = (kernel::dd-%log2 (float x 1w0))
+	and z = (/ (log (float x 1d0)) (log 2d0))
+	and e = (/ (abs (- y z)) z)
+	do (assert-true (<= e 2d-16)
+			k y z e)))
\ No newline at end of file
-- 
GitLab