diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c index d8f2cad516c2d3558d0854d26d078e90587aae2f..ecbfbd4e5c4bca07c52154bef1aad54eca2c42c4 100644 --- a/src/lisp/s_log1p.c +++ b/src/lisp/s_log1p.c @@ -114,8 +114,13 @@ static double zero = 0.0; k = 1; if (hx < 0x3FDA827A) { /* x < 0.41422 */ if(ax>=0x3ff00000) { /* x <= -1.0 */ - if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */ - else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ + if(x==-1.0) { + /* log1p(-1)=-inf */ + return fdlibm_setexception(x, FDLIBM_OVERFLOW); + } else { + /* log1p(x<-1)=NaN */ + return fdlibm_setexception(x, FDLIBM_INVALID); + } } if(ax<0x3e200000) { /* |x| < 2**-29 */ if(two54+x>zero /* raise inexact */ diff --git a/tests/trig.lisp b/tests/trig.lisp index 07cd6bd0590c789746d862cb6b6beb9b6064f3a5..1452c4c191ea417976b04cf123e6c294b3b14a7e 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -887,3 +887,16 @@ (kernel:%expm1 ext:double-float-positive-infinity))) (kernel::with-float-traps-masked (:invalid) (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) + +(define-test log1p.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%log1p -2d0)) + (assert-error 'floating-point-overflow + (kernel:%log1p -1d0)) + (assert-true (ext:float-nan-p (kernel:%log1p *qnan*))) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-negative-infinity + (kernel:%log1p -1d0))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%log1p *snan*)))))