From b9a6091a28a431b4f11300b350e77f57d8389b19 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Thu, 21 Aug 2014 21:42:06 -0700
Subject: [PATCH] Make log1p signal errors using fdlibm_setexception.

 * src/lisp/s_log1p.c:
   * Use fdlibm_setexception
 * tests/trig.lisp:
   * Add tests for log1p.
---
 src/lisp/s_log1p.c |  9 +++++++--
 tests/trig.lisp    | 13 +++++++++++++
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/src/lisp/s_log1p.c b/src/lisp/s_log1p.c
index d8f2cad51..ecbfbd4e5 100644
--- a/src/lisp/s_log1p.c
+++ b/src/lisp/s_log1p.c
@@ -114,8 +114,13 @@ static double zero = 0.0;
 	k = 1;
 	if (hx < 0x3FDA827A) {			/* x < 0.41422  */
 	    if(ax>=0x3ff00000) {		/* x <= -1.0 */
-		if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */
-		else return (x-x)/(x-x);	/* log1p(x<-1)=NaN */
+		if(x==-1.0) {
+                    /* log1p(-1)=-inf */
+                    return fdlibm_setexception(x, FDLIBM_OVERFLOW); 
+		} else {
+                    /* log1p(x<-1)=NaN */
+                    return fdlibm_setexception(x, FDLIBM_INVALID);
+                }
 	    }
 	    if(ax<0x3e200000) {			/* |x| < 2**-29 */
 		if(two54+x>zero			/* raise inexact */
diff --git a/tests/trig.lisp b/tests/trig.lisp
index 07cd6bd05..1452c4c19 100644
--- a/tests/trig.lisp
+++ b/tests/trig.lisp
@@ -887,3 +887,16 @@
 		 (kernel:%expm1 ext:double-float-positive-infinity)))
   (kernel::with-float-traps-masked (:invalid)
     (assert-true (ext::float-nan-p (kernel:%expm1 *snan*)))))
+
+(define-test log1p.exceptions
+  (:tag :fdlibm)
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%log1p -2d0))
+  (assert-error 'floating-point-overflow
+		(kernel:%log1p -1d0))
+  (assert-true (ext:float-nan-p (kernel:%log1p *qnan*)))
+  (kernel::with-float-traps-masked (:overflow)
+    (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*)))))
-- 
GitLab