diff --git a/numbers/atan.lsp b/numbers/atan.lsp index 09e24b360cf161a2e0e4493f610b0a198f2319d5..8bce4ffb23d91be3ec713ec112b5414e66cc33c8 100644 --- a/numbers/atan.lsp +++ b/numbers/atan.lsp @@ -126,6 +126,67 @@ ;;; FIXME ;;; More accuracy tests here +;;; ieee-fp tests +(deftest atan.ieee.1 :description "Verify if atan handles 0.0 correctly" + (flet ((+pi-p (elt) (= (coerce pi (type-of elt)) elt)) + (+pi/2-p (elt) (approx= (coerce (/ pi +2) (type-of elt)) elt)) + (-pi/2-p (elt) (approx= (coerce (/ pi -2) (type-of elt)) elt))) + ;; (atan +-0 +(anything-but-nan)) -> +-0 + ;; (atan +-0 -(anything-but-nan)) -> +-pi + ;; (atan +-(anything-but-0/nan) 0) -> +-pi/2 + (every (lambda (n) + ;; notice, that we don't test a case, where + ;; both arguments are 0.0, because if + ;; implementation doesn't support signed 0 + ;; result is undefined. + (and (zerop (atan 0.0 n)) + (+pi-p (atan 0.0 (- n))) + (+pi/2-p (atan n 0.0)) + (-pi/2-p (atan (- n) 0.0)))) + (remove-if-not #'plusp *floats*))) + T) + +(deftest atan.ieee.2 :description "Verify ATAN handling signed zero" + (or (plusp (float-sign -0.0)) + (flet ((+zerop (elt) + (and (zerop elt) + (plusp (float-sign elt)))) + (-zerop (elt) + (and (zerop elt) + (minusp (float-sign elt)))) + (+pi-p (elt) (= (coerce pi (type-of elt)) elt)) + (-pi-p (elt) (= (coerce pi (type-of elt)) (- elt)))) + (and + (+zerop (atan +0.0 +0.0)) + (-zerop (atan -0.0 +0.0)) + (+pi-p (atan +0.0 -0.0)) + (-pi-p (atan -0.0 -0.0)) + (every (lambda (n) + (and (-zerop (atan -0.0 n)) + (+zerop (atan +0.0 n)) + (+pi-p (atan +0.0 (- n))) + (-pi-p (atan -0.0 (- n))))) + (remove-if-not #'plusp *floats*))))) + T) + +;;; We could have tested also for infinities and nan's, but there is +;;; no portable ieee-fp, we could put it in ansi-beyond test suite +;;; though: +;;; +;;; (atan (anything) nan) -> nan +;;; (atan nan (anything)) -> nan +;;; (atan +inf +inf) -> +pi/4 +;;; (atan -inf +inf) -> -pi/4 +;;; (atan +inf -inf) -> +3pi/4 +;;; (atan -inf -inf) -> -3pi/4 +;;; (atan -(anything-but/inf+nan), +inf) -> -0 +;;; (atan +(anything-but/inf+nan), +inf) -> +0 +;;; (atan +(anything-but/inf+nan), -inf) -> +pi +;;; (atan -(anything-but/inf+nan), -inf) -> -pi +;;; (atan +inf (anything-but/0+inf+nan)) -> +pi/2 +;;; (atan -inf (anything-but/0+inf+nan)) -> -pi/2 +;;; + ;;; Error tests (deftest atan.error.1 @@ -147,7 +208,3 @@ (deftest atan.error.5 (check-type-error #'(lambda (x) (atan 1 x)) #'realp) nil) - - - -