[cmucl-commit] [git] CMU Common Lisp branch rtoy-lisp-trig updated. snapshot-2013-12-a-10-g1266d1f

Raymond Toy rtoy at common-lisp.net
Wed Dec 18 03:35:56 UTC 2013


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, rtoy-lisp-trig has been updated
       via  1266d1ff1eb938136e8ae684eb9e3be8009ec350 (commit)
      from  6ec982de562b883722c7efc85d44f9fada24b9ef (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1266d1ff1eb938136e8ae684eb9e3be8009ec350
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Tue Dec 17 13:10:30 2013 -0800

    Convert to using lisp-unit.

diff --git a/src/tests/trig.lisp b/src/tests/trig.lisp
index 57a5355..41e444a 100644
--- a/src/tests/trig.lisp
+++ b/src/tests/trig.lisp
@@ -1,238 +1,193 @@
-(rt:deftest sin.1
-    (sin 0d0)
-  0d0)
-
-(rt:deftest sin.2
-    (sin -0d0)
-  -0d0)
-
-(rt:deftest sin.3
-    ;; Tests the case for |x| < 2^-27, but not 0.
-    (sin (scale-float 1d0 -28))
-  #.(scale-float 1d0 -28))
-
-(rt:deftest sin.4
-    ;; Just a random test, without argument reduction
-    (sin .5d0)
-  0.479425538604203d0)
-
-(rt:deftest sin.5
-    ;; Test for arg near pi/2
-    (sin (/ pi 2))
-  1d0)
-
-(rt:deftest sin.red.0
-    ;; Test for argument reduction with n mod 4 = 0
-    (sin (* 7/4 pi))
-  -7.07106781186547675943154203316156531867416581156d-1)
-
-(rt:deftest sin.red.1
+(defpackage :trig-tests
+  (:use :cl :lisp-unit))
+
+(in-package "TRIG-TESTS")
+
+(define-test sin.signed-zeroes
+  "Test sin for 0d0 and -0d0"
+  (:tag :sin :signed-zeroes)
+  (assert-eql 0d0 (sin 0d0))
+  (assert-eql -0d0 (sin -0d0)))
+
+
+(define-test sin.very-small
+  "Tests sin for the case of |x| < 2^-27, but not 0."
+  (:tag :sin)
+  (assert-eql (scale-float 1d0 -28)
+	      (sin (scale-float 1d0 -28))))
+
+(define-test sin.no-reduction
+  "Test sin for small args without reduction"
+  (:tag :sin)
+  (assert-eql 0.479425538604203d0
+	      (sin .5d0))
+  (assert-eql -0.479425538604203d0
+	      (sin -0.5d0)))
+
+(define-test sin.pi/2
+  "Test for arg near pi/2"
+  (:tag :sin)
+  (assert-eql 1d0 (sin (/ pi 2))))
+
+(define-test sin.arg-reduction
+  "Test for sin with arg reduction"
+  (:tag :sin)
+  ;; Test for argument reduction with n mod 4 = 0
+  (assert-eql -7.07106781186547675943154203316156531867416581156d-1
+	      (sin (* 7/4 pi)))
     ;; Test for argument reduction with n mod 4 = 1
-    (sin (* 9/4 pi))
-  7.07106781186547329560731709118834541043171055432d-1)
-
-(rt:deftest sin.red.2
-    ;; Test for argument reduction with n mod 4 = 2
-    (sin (* 11/4 pi))
-  7.07106781186548390575743300374993861263439430213d-1)
-
-(rt:deftest sin.red.3
-    ;; Test for argument reduction with n mod 4 = 3
-    (sin (* 13/4 pi))
-  -7.07106781186547871002109559079472349116005337743d-1)
-
-(rt:deftest sin.misc.1
-    ;; Test for argument reduction
-    (sin (scale-float 1d0 120))
-  0.377820109360752d0)
-
-(rt:deftest cos.1
-    (cos 0d0)
-  1d0)
-
-(rt:deftest cos.2
-    (cos -0d0)
-  1d0)
-
-(rt:deftest cos.3
-    ;; Test for |x| < 2^-27
-    (cos (scale-float 1d0 -28))
-  1d0)
-
-(rt:deftest cos.4
-    ;; Test for branch |x| < .3
-    (cos 0.25d0)
-  0.9689124217106447d0)
-
-(rt:deftest cos.5
-    ;; Test for branch |x| > .3 and \x| < .78125
-    (cos 0.5d0)
-  8.7758256189037271611628158260382965199164519711d-1)
-
-(rt:deftest cos.6
-    ;; Test for branch |x| > .3 and |x| > .78125
-    (cos 0.785d0)
-  0.7073882691671998d0)
-
-(rt:deftest cos.7
-    ;; Random test near pi/2
-    (cos (/ pi 2))
-  6.123233995736766d-17)
-
-(rt:deftest cos.misc.1
-    ;; Test for argument reduction
-    (cos (scale-float 1d0 120))
-  -0.9258790228548379d0)
-
-(rt:deftest cos.red.0
+  (assert-eql 7.07106781186547329560731709118834541043171055432d-1
+	      (sin (* 9/4 pi)))
+  ;; Test for argument reduction with n mod 4 = 2
+  (assert-eql 7.07106781186548390575743300374993861263439430213d-1
+	      (sin (* 11/4 pi)))
+  ;; Test for argument reduction with n mod 4 = 3
+  (assert-eql -7.07106781186547871002109559079472349116005337743d-1
+	      (sin (* 13/4 pi)))
+  ;; Test for argument reduction, big value
+  (assert-eql 0.377820109360752d0
+	      (sin (scale-float 1d0 120))))
+
+(define-test sin.exceptions
+  "Test sin for exceptional values"
+  (:tag :sin :exceptions)
+  (kernel::with-float-traps-masked ()
+    (assert-error 'floating-point-invalid-operation (sin ext:double-float-positive-infinity))
+    (assert-error 'floating-point-invalid-operation (sin ext:double-float-negative-infinity))))
+
+(define-test cos.signed-zeroes
+  "Test cos for 0d0 and -0d0"
+  (:tag :cos :signed-zeroes)
+  (assert-eql 1d0 (cos 0d0))
+  (assert-eql 1d0 (cos -0d0)))
+
+(define-test cos.very-small
+  "Test cos for |x| < 2^-27"
+  (:tag :cos)
+  (assert-eql 1d0 (cos (scale-float 1d0 -28))))
+
+(define-test cos.code-paths
+  "Tests various code paths in cos evaluation"
+  (:tag :cos)
+  ;; Test for branch |x| < .3
+  (assert-eql 0.9689124217106447d0
+	      (cos 0.25d0))
+  ;; Test for branch |x| > .3 and \x| < .78125
+  (assert-eql 8.7758256189037271611628158260382965199164519711d-1
+	      (cos 0.5d0))
+  ;; Test for branch |x| > .3 and |x| > .78125
+  (assert-eql 0.7073882691671998d0
+	      (cos 0.785d0)))
+
+(define-test cos.pi/2  
+  "Test cos(pi/2)"
+  (:tag :cos)
+  (assert-eql 6.123233995736766d-17
+	      (cos (/ pi 2))))
+
+(define-test cos.arg-reduction
+  "Test for cos with arg reduction"
+  (:tag :cos)
     ;; Test for argument reduction with n mod 4 = 0
-    (cos (* 7/4 pi))
-  7.07106781186547372858534520893509069186435867941d-1)
+  (assert-eql 7.07106781186547372858534520893509069186435867941d-1
+	      (cos (* 7/4 pi)))
+  ;; Test for argument reduction with n mod 4 = 1
+  (assert-eql 7.0710678118654771924095701509080985020443197242d-1
+	      (cos (* 9/4 pi)))
+  ;; Test for argument reduction with n mod 4 = 2
+  (assert-eql -7.07106781186546658225945423833643190916000739026d-1
+	      (cos (* 11/4 pi)))
+  ;; Test for argument reduction with n mod 4 = 3
+  (assert-eql -7.07106781186547177799579165130055836531929091466d-1
+	      (cos (* 13/4 pi)))
+  ;; Test for argument reduction
+  (assert-eql -0.9258790228548379d0
+	      (cos (scale-float 1d0 120))))
+
+(define-test tan.signed-zeroes
+  "Test tan for 0d0 and -0d0"
+  (:tag :tan :signed-zeroes)
+  (assert-eql 0d0 (tan 0d0))
+  (assert-eql -0d0 (tan -0d0)))
+
+(define-test tan.very-small
+  "Test for tan, |x| < 2^-28"
+  (:tag :tan)
+  (assert-eql (scale-float 1d0 -29)
+	      (tan (scale-float 1d0 -29)))
+  (assert-eql (scale-float -1d0 -29)
+	      (tan (scale-float -1d0 -29))))
+
+(define-test tan.pi/2
+  "Test for tan(pi/2)"
+  (:tag :tan)
+  (assert-eql 1.63312393531953697559677370415289165308640681049d16
+	      (tan (/ pi 2))))
+
+(define-test tan.code-paths
+  "Tests for various code paths in tan"
+  (:tag :tan)
+  ;; |x| < .6744
+  (assert-eql 5.4630248984379051325517946578028538329755172018d-1
+	      (tan 0.5d0))
+  ;; |x = 11/16 = 0.6875 > .6744
+  (assert-eql 8.21141801589894121911423965374711700875371645309d-1
+	      (tan (float 11/16 1d0)))
+  ;; This was found by maxima's testsuite.  A bug in kernel-tan when
+  ;; returning cot(x).
+  (assert-eql 2.0000000000000028604455051971538975562294147582d0
+	      (tan 1.107148717794091d0)))
+
+(define-test tan.arg-reduction
+  "Test for tan with arg reduction"
+  (:tag :tan)
+  ;; Test for argument reduction with n even
+  (assert-eql -1.00000000000000042862637970157370388940976433505d0
+	      (tan (* 7/4 pi)))
+  ;; Test for argument reduction with n odd
+  (assert-eql 9.99999999999999448908940383691222098948324989275d-1
+	      (tan (* 9/4 pi)))
+  (assert-eql -4.08066388841804238545143494525595117765084022768d-1
+	      (tan (scale-float 1d0 120))))
+
+
+(define-test sincos.signed-zeroes
+  "Test sincos at 0d0, -0d0"
+  (:tag :sincos :signed-zeroes)
+  (assert-equal '(0d0 1d0)
+		(multiple-value-list (kernel::%sincos 0d0)))
+  (assert-equal '(-0d0 1d0)
+		(multiple-value-list (kernel::%sincos -0d0))))
+
+(defun sincos-test (limit n)
+  (let (results)
+    (dotimes (k n)
+      (let* ((x (random limit))
+	     (s-exp (sin x))
+	     (c-exp (cos x)))
+	(multiple-value-bind (s c)
+	    (kernel::%sincos x)
+	  (unless (and (eql s s-exp)
+		       (eql c c-exp))
+	    (push (list x
+			(list s s-exp)
+			(list c c-exp))
+		  results)))))
+    results))
+
+(define-test sincos.consistent
+  "Test sincos is consistent with sin and cos"
+  (:tag :sincos)
+  ;; Small values
+  (assert-eql nil
+	      (sincos-test (/ pi 4) 1000))
+  ;; Medium
+  (assert-eql nil
+	      (sincos-test 16d0 1000))
+  ;; Large
+  (assert-eql nil
+	      (sincos-test (scale-float 1d0 120) 1000))
+  ;; Very large
+  (assert-eql nil
+	      (sincos-test (scale-float 1d0 1023) 1000)))
 
-(rt:deftest cos.red.1
-    ;; Test for argument reduction with n mod 4 = 1
-    (cos (* 9/4 pi))
-  7.0710678118654771924095701509080985020443197242d-1)
-
-(rt:deftest cos.red.2
-    ;; Test for argument reduction with n mod 4 = 2
-    (cos (* 11/4 pi))
-  -7.07106781186546658225945423833643190916000739026d-1)
-
-(rt:deftest cos.red.3
-    ;; Test for argument reduction with n mod 4 = 3
-    (cos (* 13/4 pi))
-  -7.07106781186547177799579165130055836531929091466d-1)
-
-(rt:deftest tan.1
-    (tan 0d0)
-  0d0)
-
-(rt:deftest tan.2
-    (tan -0d0)
-  -0d0)
-
-(rt:deftest tan.3
-  ;; |x| < 2^-28
-    (tan (scale-float 1d0 -29))
-  #.(scale-float 1d0 -29))
-
-(rt:deftest tan.4
-    ;; |x| < .6744
-    (tan 0.5d0)
-  5.4630248984379051325517946578028538329755172018d-1)
-
-(rt:deftest tan.5
-    ;; |x = 11/16 = 0.6875 > .6744
-    (tan (float 11/16 1d0))
-  8.21141801589894121911423965374711700875371645309d-1)
-
-(rt:deftest tan.6
-    ;; This was found by maxima's testsuite.  A bug in kernel-tan when
-    ;; returning cot(x).
-    (tan 1.107148717794091d0)
-  2.0000000000000028604455051971538975562294147582d0)
-
-(rt:deftest tan.red.0
-    ;; Test for argument reduction with n even
-    (tan (* 7/4 pi))
-  -1.00000000000000042862637970157370388940976433505d0)
-
-(rt:deftest tan.red.1
-    ;; Test for argument reduction with n odd
-    (tan (* 9/4 pi))
-  9.99999999999999448908940383691222098948324989275d-1)
-
-(rt:deftest tan.misc.1
-    (tan (scale-float 1d0 120))
-  -4.08066388841804238545143494525595117765084022768d-1)
-
-
-(rt:deftest sincos.0
-    (multiple-value-list (kernel::%sincos -0d0))
-  (-0d0 1d0))
-
-(rt:deftest sincos.1
-    (let (results)
-      (dotimes (k 1000)
-	(let* ((x (random (/ pi 4)))
-	       (s-exp (sin x))
-	       (c-exp (cos x)))
-	  (multiple-value-bind (s c)
-	      (kernel::%sincos x)
-	    (unless (and (= s s-exp)
-			 (= c c-exp))
-	      (push (list x
-			  (list s s-exp)
-			  (list c c-exp))
-		    results)))))
-      results)
-  nil)
-
-(rt:deftest sincos.2
-    (let (results)
-      (dotimes (k 1000)
-	(let* ((x (random 16d0))
-	       (s-exp (sin x))
-	       (c-exp (cos x)))
-	  (multiple-value-bind (s c)
-	      (kernel::%sincos x)
-	    (unless (and (= s s-exp)
-			 (= c c-exp))
-	      (push (list x
-			  (list s s-exp)
-			  (list c c-exp))
-		    results)))))
-      results)
-  nil)
-
-(rt:deftest sincos.3
-    (let (results)
-      (dotimes (k 1000)
-	(let* ((x (random (scale-float 1d0 120)))
-	       (s-exp (sin x))
-	       (c-exp (cos x)))
-	  (multiple-value-bind (s c)
-	      (kernel::%sincos x)
-	    (unless (and (= s s-exp)
-			 (= c c-exp))
-	      (push (list x
-			  (list s s-exp)
-			  (list c c-exp))
-		    results)))))
-      results)
-  nil)
-
-(rt:deftest sincos.3a
-    (let (results)
-      (dotimes (k 1000)
-	(let* ((x (- (random (scale-float 1d0 120))))
-	       (s-exp (sin x))
-	       (c-exp (cos x)))
-	  (multiple-value-bind (s c)
-	      (kernel::%sincos x)
-	    (unless (and (= s s-exp)
-			 (= c c-exp))
-	      (push (list x
-			  (list s s-exp)
-			  (list c c-exp))
-		    results)))))
-      results)
-  nil)
-
-(rt:deftest sincos.4
-    (let (results)
-      (dotimes (k 1000)
-	(let* ((x (random (scale-float 1d0 1023)))
-	       (s-exp (sin x))
-	       (c-exp (cos x)))
-	  (multiple-value-bind (s c)
-	      (kernel::%sincos x)
-	    (unless (and (= s s-exp)
-			 (= c c-exp))
-	      (push (list x
-			  (list s s-exp)
-			  (list c c-exp))
-		    results)))))
-      results)
-  nil)

-----------------------------------------------------------------------

Summary of changes:
 src/tests/trig.lisp |  425 +++++++++++++++++++++++----------------------------
 1 file changed, 190 insertions(+), 235 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp


More information about the cmucl-commit mailing list