From a31150c58c2727fcf802984b8306b849e6c5cba1 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Thu, 24 Dec 2015 08:59:29 -0800
Subject: [PATCH] Use setexception to raise the inexact exception for tan.

---
 src/lisp/k_tan.c  | 45 ++++++++++++++++++++++++---------------------
 tests/fdlibm.lisp | 15 +++++++++++++++
 2 files changed, 39 insertions(+), 21 deletions(-)

diff --git a/src/lisp/k_tan.c b/src/lisp/k_tan.c
index 10fa56297..6a3d40100 100644
--- a/src/lisp/k_tan.c
+++ b/src/lisp/k_tan.c
@@ -78,31 +78,34 @@ __kernel_tan(double x, double y, int iy) {
 	hx = ux.i[HIWORD];		/* high word of x */
 	ix = hx & 0x7fffffff;			/* high word of |x| */
 	if (ix < 0x3e300000) {			/* x < 2**-28 */
-		if ((int) x == 0) {		/* generate inexact */
-			if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0)
-				return one / fabs(x);
-			else {
-				if (iy == 1)
-					return x;
-				else {	/* compute -1 / (x+y) carefully */
-					double a, t;
+            /* return x inexact except 0 */
+            if (x != 0) {
+                fdlibm_setexception(x, FDLIBM_INEXACT);
+            }
 
-					z = w = x + y;
-                                        uz.d = z;
-					uz.i[LOWORD] = 0;
-                                        z = ux.d;
+	    if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0)
+		return one / fabs(x);
+	    else {
+		if (iy == 1)
+		    return x;
+		else {	/* compute -1 / (x+y) carefully */
+		    double a, t;
+
+		    z = w = x + y;
+		    uz.d = z;
+		    uz.i[LOWORD] = 0;
+		    z = ux.d;
                                         
-					v = y - (z - x);
-					t = a = -one / w;
-                                        uz.d = t;
-                                        uz.i[LOWORD] = 0;
-                                        t = uz.d;
+		    v = y - (z - x);
+		    t = a = -one / w;
+		    uz.d = t;
+		    uz.i[LOWORD] = 0;
+		    t = uz.d;
                                         
-					s = one + t * z;
-					return t + a * (s + t * v);
-				}
-			}
+		    s = one + t * z;
+		    return t + a * (s + t * v);
 		}
+	    }
 	}
 	if (ix >= 0x3FE59428) {	/* |x| >= 0.6744 */
 		if (hx < 0) {
diff --git a/tests/fdlibm.lisp b/tests/fdlibm.lisp
index a4a0ca76a..5fb22a4a7 100644
--- a/tests/fdlibm.lisp
+++ b/tests/fdlibm.lisp
@@ -638,3 +638,18 @@
 	(assert-error 'floating-point-inexact
 		      (kernel:%sin x)))))
 
+(define-test %tan.exceptions
+    (:tag :fdlibm)
+  ;; tan(x) = x for |x| < 2^-28.  Signal inexact unless x = 0
+  (let ((x (scale-float 1d0 -29))
+	(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:%tan 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:%tan x)))))
+
-- 
GitLab