[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