Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl
Commits:
2 changed files:
Changes:
src/lisp/s_log1p.c
--- 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;
}
tests/fdlibm.lisp
--- 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)