mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 05:21:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

atan: ieee: polish tests

Browse source
This commit is contained in:
Daniel Kochmański 2016-12-23 08:55:45 +01:00
parent 6d627a3fd9
commit bfeec4aa21
2 changed files with 60 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

146
src/tests/normal-tests/ieee-fp.lsp
View file

@ -71,103 +71,55 @@
;;; Test corner-cases of calculating atan2
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/issues/332
(defparameter *ieee-fp.negative-inf*
(list ext:short-float-negative-infinity
ext:single-float-negative-infinity
ext:double-float-negative-infinity
ext:long-float-negative-infinity))
(flet((+pi-p (elt) (= (coerce pi (type-of elt)) elt))
(-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))
(+zerop (elt) (and (zerop elt) (plusp (float-sign elt))))
(-zerop (elt) (and (zerop elt) (minusp (float-sign elt)))))
(defparameter *ieee-fp.positive-inf*
(list ext:short-float-positive-infinity
ext:single-float-positive-infinity
ext:double-float-positive-infinity
ext:long-float-positive-infinity))
(test ieee-fp.0004.atan2-special-cases.nan-arg
(without-fpe-traps
;; (atan (anything) nan) -> nan
;; (atan nan (anything)) -> nan
(map () (lambda (n)
(is (si:float-nan-p (atan n (si:nan))))
(is (si:float-nan-p (atan (si:nan) n))))
(append *floats* *ieee-fp.inf* (list (si:nan))))))
(defparameter *ieee-fp.inf*
(list ext:short-float-negative-infinity
ext:single-float-negative-infinity
ext:double-float-negative-infinity
ext:long-float-negative-infinity
ext:short-float-positive-infinity
ext:single-float-positive-infinity
ext:double-float-positive-infinity
ext:long-float-positive-infinity))
(test ieee-fp.0005.atan2-special-case.zero-arg
(+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))
(map () (lambda (n)
;; (atan +-0 +(anything-but/nan)) -> +-0
(is (+zerop (atan +0.0 n)))
(is (-zerop (atan -0.0 n)))
;; (atan +-0 -(anything-but/nan)) -> +-pi
(is (+pi-p (atan +0.0 (- n))))
(is (-pi-p (atan -0.0 (- n))))
;; (atan +-(anything-but/0+nan) 0) -> +-pi/2
(is (+pi/2-p (atan n +0.0)))
(is (+pi/2-p (atan n -0.0)))
(is (-pi/2-p (atan (- n) +0.0)))
(is (-pi/2-p (atan (- n) -0.0))))
(remove-if-not #'plusp (append *floats* *ieee-fp.inf*))))
(defparameter *ieee-fp.anything*
(append *floats*
(list -0.0 +0.0 (si:nan))
*ieee-fp.inf*))
(defparameter *ieee-fp.anything/but-nan*
(remove-if #'si::float-nan-p *ieee-fp.anything*))
(defparameter *ieee-fp.anything/but-0+nan*
(remove-if (lambda (x)
(or (si::float-nan-p x)
(si::zerop x)))
*ieee-fp.anything*))
(defparameter *ieee-fp.anything/but-inf+nan*
(remove-if (lambda (x)
(or (si::float-nan-p x)
(si::float-infinity-p x)))
*ieee-fp.anything*))
(defparameter *ieee-fp.anything/but-0+inf+nan*
(remove-if (lambda (x)
(or (si::float-nan-p x)
(si::float-infinity-p x)
(zerop x)))
*ieee-fp.anything*))
(defun pip (my-pi number)
(<= (abs (- (abs my-pi) (abs number))) 0.01))
(test ieee-fp.0004.atan2-special-cases.nan-arg
(without-fpe-traps
;; (atan (anything) nan) -> nan
;; (atan nan (anything)) -> nan
(map () (lambda (n)
(is (si:float-nan-p (atan n (si:nan))))
(is (si:float-nan-p (atan (si:nan) n))))
*ieee-fp.anything*)))
(test ieee-fp.0005.atan2-special-case.zero-arg
;; (atan +-0 +(anything-but-nan)) -> +-0
;; (atan +-0 -(anything-but-nan)) -> +-pi
(map () (lambda (n)
(is (zerop (atan -0.0 n)))
(is (zerop (atan +0.0 n)))
(is (pip pi (atan +0.0 (- n))))
(is (pip pi (atan -0.0 (- n)))))
(remove-if-not #'plusp *ieee-fp.anything/but-nan*))
;; (atan +-(anything-but-0/nan) 0) -> +-pi/2
(map () (lambda (n)
(is (pip (* +1/2 pi) (atan n +0.0)))
(is (pip (* -1/2 pi) (atan n -0.0))))
*ieee-fp.anything/but-0+nan*))
(test ieee-fp.0006.atan2-special-case.inf-arg
;; (atan +-inf +inf) -> +-pi/4
(map () (lambda (n)
(map () (lambda (m) (is (pip (/ pi 4) (atan n m))))
*ieee-fp.positive-inf*))
*ieee-fp.inf*)
;; (atan +-inf -inf) -> +-3pi/4
(map () (lambda (n)
(map () (lambda (m) (is (pip (* 3/4 pi) (atan n m))))
*ieee-fp.negative-inf*))
*ieee-fp.inf*)
(map () (lambda (n)
;; (atan +-(anything-but-inf/nan), +inf) -> +-0
(map () (lambda (m) (is (zerop (atan n m))))
*ieee-fp.positive-inf*)
;; (atan +-(anything-but-inf/nan), -inf) -> +-pi
(map () (lambda (m) (is (pip pi (atan n m))))
*ieee-fp.negative-inf*))
*ieee-fp.anything/but-inf+nan*)
;; (atan +-inf (anything-but-0/nan/inf)) -> +-pi/2
(map () (lambda (n)
(map () (lambda (m) (is (pip (/ pi 2) (atan m n))))
*ieee-fp.inf*))
*ieee-fp.anything/but-0+inf+nan*))
(test ieee-fp.0006.atan2-special-case.inf-arg
;; (atan +-inf +inf) -> +-pi/4
(let ((+inf ext:single-float-positive-infinity)
(-inf ext:single-float-negative-infinity))
(is (approx= (atan +inf +inf) (* +1/4 pi)))
(is (approx= (atan -inf +inf) (* -1/4 pi)))
(is (approx= (atan +inf -inf) (* +3/4 pi)))
(is (approx= (atan -inf -inf) (* -3/4 pi)))
(map () (lambda (n)
(is (+zerop (atan n +inf)))
(is (-zerop (atan (- n) +inf)))
(is (+pi-p (atan n -inf)))
(is (-pi-p (atan (- n) -inf)))
(unless (zerop n)
(+pi/2-p (atan +inf n))
(-pi/2-p (atan -inf n))))
(remove-if-not #'plusp *floats*)))))

11
src/tests/universe.lisp
View file

@ -118,6 +118,17 @@
1.31273s3 12361.12S-7
6124.124l0 13123.1L-23)))
#+ieee-floating-point
(defparameter *ieee-fp.inf*
(list ext:short-float-negative-infinity
ext:single-float-negative-infinity
ext:double-float-negative-infinity
ext:long-float-negative-infinity
ext:short-float-positive-infinity
ext:single-float-positive-infinity
ext:double-float-positive-infinity
ext:long-float-positive-infinity))
(defparameter *ratios*
'(1/3 1/1000 1/1000000000000000 -10/3 -1000/7 -987129387912381/13612986912361
189729874978126783786123/1234678123487612347896123467851234671234))