diff --git a/src/lisp/e_atanh.c b/src/lisp/e_atanh.c index 358843698fa156d7c67b23f325e868146b41639c..aed70d465d46b7d1304badae6688ea375a74d434 100644 --- a/src/lisp/e_atanh.c +++ b/src/lisp/e_atanh.c @@ -57,10 +57,11 @@ static double zero = 0.0; lx = ux.i[LOWORD]; /* low word */ ix = hx&0x7fffffff; if ((ix|((lx|(-lx))>>31))>0x3ff00000) /* |x|>1 */ - return (x-x)/(x-x); - if(ix==0x3ff00000) - return x/zero; - if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */ + return fdlibm_setexception(x, FDLIBM_INVALID); + if(ix==0x3ff00000) + return fdlibm_setexception(x, FDLIBM_DIVIDE_BY_ZERO); + + if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */ ux.d = x; ux.i[HIWORD] = ix; /* x <- |x| */ x = ux.d; diff --git a/tests/trig.lisp b/tests/trig.lisp index d95db71c929ef01367c6e0d3ef5f060274d41a78..1b6102d9cd03f29c0cf61dd4d8db772d15bdc46c 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -888,6 +888,26 @@ (kernel::with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))) +(define-test atanh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%atanh 2d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%atanh -2d0)) + (assert-error 'division-by-zero + (kernel:%atanh 1d0)) + (assert-error 'division-by-zero + (kernel:%atanh -1d0)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%atanh 2d0))) + (assert-true (ext:float-nan-p (kernel:%atanh -2d0)))) + (kernel::with-float-traps-masked (:divide-by-zero) + (assert-equal ext:double-float-positive-infinity + (kernel:%atanh 1d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%atanh -1d0)))) + + (define-test expm1.exceptions (:tag :fdlibm) (assert-error 'floating-point-overflow