From 91ff36070092df5d879081a435bd7d22587c8717 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 24 Dec 2015 09:23:06 -0800 Subject: [PATCH] Use setexception to raise the inexact exception for %log1p. --- src/lisp/s_log1p.c | 9 +++++++-- tests/fdlibm.lisp | 14 +++++++++++++- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c index ecbfbd4e5..41173a463 100644 --- a/src/lisp/s_log1p.c +++ b/src/lisp/s_log1p.c @@ -123,9 +123,14 @@ static double zero = 0.0; } } if(ax<0x3e200000) { /* |x| < 2**-29 */ - if(two54+x>zero /* raise inexact */ - &&ax<0x3c900000) /* |x| < 2**-54 */ + if (ax < 0x3c900000) { /* |x| < 2**-54 */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + return x; + } else return x - x*x*0.5; } diff --git a/tests/fdlibm.lisp b/tests/fdlibm.lisp index 5bde0cfdc..4a1087745 100644 --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -181,7 +181,19 @@ (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*))))) + (assert-true (ext:float-nan-p (kernel:%log1p *snan*)))) + ;; log1p(x) = x for |x| < 2^-54, signaling inexact except for x = 0. + (let ((x (scale-float 1d0 -55)) + (x0 0d0)) + (with-inexact-exception-enabled + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%log1p x0))) + (with-inexact-exception-enabled + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%log1p x))))) (define-test %exp.exceptions (:tag :fdlibm) -- GitLab