From 2e3e48d466c67a09ea7aeb23106fdc50143be3b5 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Fri, 20 Dec 2013 16:07:12 -0800
Subject: [PATCH] Add tests for double-double trig functions.

---
 src/tests/trig.lisp | 173 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 173 insertions(+)

diff --git a/src/tests/trig.lisp b/src/tests/trig.lisp
index 58d10b63f..911b62397 100644
--- a/src/tests/trig.lisp
+++ b/src/tests/trig.lisp
@@ -215,3 +215,176 @@
   (assert-eql nil
 	      (sincos-test (scale-float 1d0 1023) 1000)))
 
+;; Compute the relative error between actual and expected if expected
+;; is not zero. Otherwise, return absolute error between actual and
+;; expected.  If the error is less than the threshold, return T.
+;; Otherwise return the actual (relative or absolute) error.
+(defun rel-or-abs-error (actual expected &optional (threshold double-float-epsilon))
+  (let ((err (if (zerop expected)
+		 (abs (- actual expected))
+		 (/ (abs (- actual expected))
+		    (abs expected)))))
+    (if (<= err threshold)
+	t
+	err)))
+
+(define-test dd-sin.signed-zeroes
+  "Test sin for 0w0 and -0w0"
+  (:tag :sin :double-double :signed-zeroes)
+  (assert-eql 0w0 (sin 0w0))
+  (assert-equal -0w0 (sin -0w0)))
+
+(define-test dd-sin.no-reduction
+  "Test sin for small args without reduction"
+  (:tag :sin :double-double)
+  (assert-eq t (rel-or-abs-error
+		(sin .5w0)
+		4.794255386042030002732879352155713880818033679406006751886166131w-1
+		1w-32))
+  (assert-eq t (rel-or-abs-error
+		(sin -0.5w0)
+		-4.794255386042030002732879352155713880818033679406006751886166131w-1
+		1w-32)))
+
+(define-test dd-sin.pi/2
+  "Test for arg near pi/2"
+  (:tag :sin :double-double)
+  (assert-eq t (rel-or-abs-error
+		(sin (/ kernel:dd-pi 2))
+		1w0
+		1w-50)))
+
+;; The reference value were computed using maxima.  Here's how to
+;; compute the reference value.  Set fpprec:64 to tell maxima to use
+;; 64 digits of precision. For 7/4*pi, do (integer-decode-float (* 7/4
+;; kernel:dd-pi)) to get the exact rational representation of the
+;; desired double-double-float.  Then bfloat(sin(<rational>)).
+(define-test dd-sin.arg-reduction
+  "Test for sin with arg reduction"
+  (:tag :sin :double-double)
+  ;; Test for argument reduction with n mod 4 = 0
+  (assert-eq t (rel-or-abs-error
+		(sin (* 7/4 kernel:dd-pi))
+		-7.07106781186547524400844362104849691328261037289050238659653433w-1
+		0w0))
+    ;; Test for argument reduction with n mod 4 = 1
+  (assert-eq t (rel-or-abs-error
+		(sin (* 9/4 kernel:dd-pi))
+		7.07106781186547524400844362104858161816423215627023442400880643w-1
+		0w0))
+  ;; Test for argument reduction with n mod 4 = 2
+  (assert-eq t (rel-or-abs-error
+		(sin (* 11/4 kernel:dd-pi))
+		7.071067811865475244008443621048998682901731241858306822215522497w-1
+		8.716w-33))
+  ;; Test for argument reduction with n mod 4 = 3
+  (assert-eq t (rel-or-abs-error
+		(sin (* 13/4 kernel:dd-pi))
+		-7.071067811865475244008443621048777109664479707052746581685893187w-1
+		8.716w-33))
+  ;; Test for argument reduction, big value
+  (assert-eq t (rel-or-abs-error
+		(sin (scale-float 1w0 120))
+		3.778201093607520226555484700569229919605866976512306642257987199w-1
+		8.156w-33)))
+
+(define-test dd-cos.signed-zeroes
+  "Test cos for 0w0 and -0w0"
+  (:tag :cos :double-double :signed-zeroes)
+  (assert-eql 1w0 (cos 0w0))
+  (assert-equal 1w0 (cos -0w0)))
+
+(define-test dd-cos.no-reduction
+  "Test cos for small args without reduction"
+  (:tag :cos :double-double)
+  (assert-eq t (rel-or-abs-error
+		(cos .5w0)
+		8.775825618903727161162815826038296519916451971097440529976108683w-1
+		0w0))
+  (assert-eq t (rel-or-abs-error
+		(cos -0.5w0)
+		8.775825618903727161162815826038296519916451971097440529976108683w-1
+		0w0)))
+
+(define-test dd-cos.pi/2
+  "Test for arg near pi/2"
+  (:tag :cos :double-double)
+  (assert-eq t (rel-or-abs-error
+		(cos (/ kernel:dd-pi 2))
+		-1.497384904859169777320797133937725094986669701841027904483071358w-33
+		0w0)))
+
+(define-test dd-cos.arg-reduction
+  "Test for cos with arg reduction"
+  (:tag :cos :double-double)
+  ;; Test for argument reduction with n mod 4 = 0
+  (assert-eq t (rel-or-abs-error
+		(cos (* 7/4 kernel:dd-pi))
+		7.07106781186547524400844362104849691328261037289050238659653433w-1
+		0w0))
+    ;; Test for argument reduction with n mod 4 = 1
+  (assert-eq t (rel-or-abs-error
+		(cos (* 9/4 kernel:dd-pi))
+		7.07106781186547524400844362104858161816423215627023442400880643w-1
+		3.487w-32))
+  ;; Test for argument reduction with n mod 4 = 2
+  (assert-eq t (rel-or-abs-error
+		(cos (* 11/4 kernel:dd-pi))
+		-7.071067811865475244008443621048998682901731241858306822215522497w-1
+		1.482w-31))
+  ;; Test for argument reduction with n mod 4 = 3
+  (assert-eq t (rel-or-abs-error
+		(cos (* 13/4 kernel:dd-pi))
+		-7.071067811865475244008443621048777109664479707052746581685893187w-1
+		7.845w-32))
+  ;; Test for argument reduction, big value
+  (assert-eq t (rel-or-abs-error
+		(cos (scale-float 1w0 120))
+		-9.258790228548378673038617641074149467308332099286564602360493726w-1
+		0w0)))
+
+(define-test dd-tan.signed-zeroes
+  "Test tan for 0w0 and -0w0"
+  (:tag :tan :double-double :signed-zeroes)
+  (assert-eql 0w0 (tan 0w0))
+  (assert-equal -0w0 (tan -0w0)))
+
+(define-test dd-tan.no-reduction
+  "Test tan for small args without reduction"
+  (:tag :tan :double-double)
+  (assert-eq t (rel-or-abs-error
+		(tan .5w0)
+		5.463024898437905132551794657802853832975517201797912461640913859w-1
+		0w0))
+  (assert-eq t (rel-or-abs-error
+		(tan -0.5w0)
+		-5.463024898437905132551794657802853832975517201797912461640913859w-1
+		0w0)))
+
+(define-test dd-tan.pi/2
+  "Test for arg near pi/2"
+  (:tag :tan :double-double)
+  (assert-eq t (rel-or-abs-error
+		(tan (/ kernel:dd-pi 2))
+		-6.67830961000672557834948096545679895621313886078988606234681001w32
+		0w0)))
+
+(define-test dd-tan.arg-reduction
+  "Test for tan with arg reduction"
+  (:tag :tan :double-double)
+  ;; Test for argument reduction with n even
+  (assert-eq t (rel-or-abs-error
+		(tan (* 7/4 kernel:dd-pi))
+		-1.000000000000000000000000000000001844257310064121018312678894979w0
+		6.467w-33))
+  ;; Test for argument reduction with n odd
+  (assert-eq t (rel-or-abs-error
+		(tan (* 9/4 kernel:dd-pi))
+		1.000000000000000000000000000000025802415787810837455445433037983w0
+		5.773w-33))
+  ;; Test for argument reduction, big value
+  (assert-eq t (rel-or-abs-error
+		(tan (scale-float 1w0 120))
+		-4.080663888418042385451434945255951177650840227682488471558860153w-1
+		1.888w-33)))
+
-- 
GitLab