[git] CMU Common Lisp branch master updated. snapshot-2014-08-21-g3309732

Raymond Toy rtoy at common-lisp.net
Fri Aug 22 04:51:20 UTC 2014


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  33097329493c7a767bcc4434f3212badcb33236a (commit)
      from  d2f946ac549cdc8da46c3bfbee61c52d8fd81f5e (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 33097329493c7a767bcc4434f3212badcb33236a
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Thu Aug 21 21:51:13 2014 -0700

    Make exp signal errors using fdlibm_setexception.
    
     * src/lisp/e_exp.c
       * Use fdlibm_setexception
     * tests/trig.lisp:
       * Add tests for exp.

diff --git a/src/lisp/e_exp.c b/src/lisp/e_exp.c
index 8b7ff6d..034c590 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 2f4a945..5001375 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

-----------------------------------------------------------------------

Summary of changes:
 src/lisp/e_exp.c |   17 ++++++++++++-----
 tests/trig.lisp  |   13 +++++++++++++
 2 files changed, 25 insertions(+), 5 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp



More information about the cmucl-cvs mailing list