From b9a6091a28a431b4f11300b350e77f57d8389b19 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 21 Aug 2014 21:42:06 -0700 Subject: [PATCH] Make log1p signal errors using fdlibm_setexception. * src/lisp/s_log1p.c: * Use fdlibm_setexception * tests/trig.lisp: * Add tests for log1p. --- src/lisp/s_log1p.c | 9 +++++++-- tests/trig.lisp | 13 +++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c index d8f2cad51..ecbfbd4e5 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 07cd6bd05..1452c4c19 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*))))) -- GitLab