From 33097329493c7a767bcc4434f3212badcb33236a Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 21 Aug 2014 21:51:13 -0700 Subject: [PATCH] Make exp signal errors using fdlibm_setexception. * src/lisp/e_exp.c * Use fdlibm_setexception * tests/trig.lisp: * Add tests for exp. --- src/lisp/e_exp.c | 17 ++++++++++++----- tests/trig.lisp | 13 +++++++++++++ 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/src/lisp/e_exp.c b/src/lisp/e_exp.c index 8b7ff6d7a..034c59050 100644 --- a/src/lisp/e_exp.c +++ b/src/lisp/e_exp.c @@ -130,12 +130,19 @@ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ /* filter out non-finite argument */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { - if(((hx&0xfffff)|ux.i[LOWORD])!=0) - return x+x; /* NaN */ - else return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */ + if(((hx&0xfffff)|ux.i[LOWORD])!=0) { + /* NaN */ + return fdlibm_setexception(x, FDLIBM_INVALID); + } else { + return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */ + } } - if(x > o_threshold) return huge*huge; /* overflow */ - if(x < u_threshold) return twom1000*twom1000; /* underflow */ + if(x > o_threshold) { + /* overflow */ + return fdlibm_setexception(x, FDLIBM_OVERFLOW); + } + + if(x < u_threshold) return x; /* underflow */ } /* argument reduction */ diff --git a/tests/trig.lisp b/tests/trig.lisp index 2f4a945da..50013750b 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -899,3 +899,16 @@ (kernel:%log1p -1d0))) (kernel::with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%log1p *snan*))))) + +(define-test exp.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%exp 710d0)) + (assert-true (ext:float-nan-p (kernel:%exp *qnan*))) + (assert-error 'floating-point-invalid-operation + (kernel:%exp *snan*)) + (assert-equal ext:double-float-positive-infinity + (kernel:%exp ext:double-float-positive-infinity)) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%exp 710d0)))) \ No newline at end of file -- GitLab