diff --git a/src/lisp/s_expm1.c b/src/lisp/s_expm1.c index 74318851676bc618aca42488a3aee666fe331de2..4e9bae8174ffa2e63f816a63e96e751055741da9 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 62ac377d47e7e8d736537775dcfbaafc3be58d16..07cd6bd0590c789746d862cb6b6beb9b6064f3a5 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*)))))