From a206017de697d0bd41545b300669138d5d5533ff Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 21 Aug 2014 20:41:10 -0700 Subject: [PATCH] Make expm1 signal errors using fdlibm_setexception. Update tests to handle signaling and quite NaN * src/lisp/s_expm1.c: * Use fdlibm_setexception * tests/trig.lisp: * Add additional tests to existing testsuite to distinguish signaling and quiet NaN. The functions should signal on quiet NaN. * Add tests for expm1. --- src/lisp/s_expm1.c | 10 +++++++--- tests/trig.lisp | 41 ++++++++++++++++++++++++++++++++++------- 2 files changed, 41 insertions(+), 10 deletions(-) diff --git a/src/lisp/s_expm1.c b/src/lisp/s_expm1.c index 743188516..4e9bae817 100644 --- a/src/lisp/s_expm1.c +++ b/src/lisp/s_expm1.c @@ -150,10 +150,14 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { if(((hx&0xfffff)|ux.i[LOWORD])!=0) - return x+x; /* NaN */ - else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ + return fdlibm_setexception(x, FDLIBM_INVALID); /* NaN */ + else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ } - if(x > o_threshold) return huge*huge; /* overflow */ + if(x > o_threshold) { + /* overflow */ + return fdlibm_setexception(x, FDLIBM_OVERFLOW); + } + } if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */ if(x+tiny<0.0) /* raise inexact */ diff --git a/tests/trig.lisp b/tests/trig.lisp index 62ac377d4..07cd6bd05 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -794,10 +794,14 @@ ;; Test that fdlibm routines signals exceptions as expected. -(defparameter *nan* +(defparameter *qnan* (kernel::with-float-traps-masked (:invalid) (* 0 ext:double-float-positive-infinity)) - "Some randon MaN value") + "Some randon quiet MaN value") + +(defparameter *snan* + (kernel:make-double-float #x7ff00000 1) + "A randon signaling MaN value") (define-test cosh.exceptions (:tag :fdlibm) @@ -806,7 +810,9 @@ (assert-error 'floating-point-overflow (kernel:%cosh -1000d0)) (assert-error 'floating-point-invalid-operation - (kernel:%cosh *nan*)) + (kernel:%cosh *snan*)) + (assert-true (ext:float-nan-p (kernel:%cosh *qnan*))) + ;; Same, but with overflow's masked (kernel::with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity @@ -819,7 +825,7 @@ (kernel:%cosh ext:double-float-negative-infinity))) ;; Test NaN (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%cosh *nan*))))) + (assert-true (ext:float-nan-p (kernel:%cosh *snan*))))) (define-test sinh.exceptions (:tag :fdlibm) @@ -828,7 +834,8 @@ (assert-error 'floating-point-overflow (kernel:%sinh -1000d0)) (assert-error 'floating-point-invalid-operation - (kernel:%sinh *nan*)) + (kernel:%sinh *snan*)) + (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))) ;; Same, but with overflow's masked (kernel::with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity @@ -841,12 +848,16 @@ (kernel:%sinh ext:double-float-negative-infinity))) ;; Test NaN (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%sinh *nan*))))) + (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))))) (define-test tanh.exceptions (:tag :fdlibm) - (assert-true (ext:float-nan-p (kernel:%tanh *nan*)))) + (assert-true (ext:float-nan-p (kernel:%tanh *qnan*))) + (assert-error 'floating-point-invalid-operation + (kernel:%tanh *snan*)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))) (define-test acosh.exceptions (:tag :fdlibm) @@ -860,3 +871,19 @@ (kernel::with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%acosh 0d0))))) +(define-test expm1.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%expm1 709.8d0)) + (assert-equal 'ext:double-float-positive-infinity + (kernel:%expm1 ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation + (kernel:%expm1 *snan*)) + (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*))) + (kernel::with-float-traps-masked (:overflow) + (assert-true ext:double-float-positive-infinity + (kernel:%expm1 709.8d0)) + (assert-true ext:double-float-positive-infinity + (kernel:%expm1 ext:double-float-positive-infinity))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) -- GitLab