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@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