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