[Git][cmucl/cmucl][rtoy-setexception-inexact] 3 commits: Use setexception to raise the inexact exception for asin.

23 Dec 2015

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl


Commits:
e655d017 by Raymond Toy at 2015-12-23T14:30:10Z
Use setexception to raise the inexact exception for asin.

o Add tests for this
o Use setexception for inexact in e_asin.c.

- - - - -
8b36c06e by Raymond Toy at 2015-12-23T15:48:58Z
Group the inexact exception test with the exceptions tests.

- - - - -
b4c91767 by Raymond Toy at 2015-12-23T15:55:19Z
Use setexception to raise the inexact exception for exp.

o Add tests for this
o Use setexception for inexact in e_exp.c.

- - - - -


3 changed files:

- src/lisp/e_asin.c
- src/lisp/e_exp.c
- tests/fdlibm.lisp


Changes:

=====================================
src/lisp/e_asin.c
=====================================

--- a/src/lisp/e_asin.c
+++ b/src/lisp/e_asin.c
@@ -89,7 +89,12 @@ qS4 =  7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
 	    return fdlibm_setexception(x, FDLIBM_INVALID);
 	} else if (ix<0x3fe00000) {	/* |x|<0.5 */
 	    if(ix<0x3e400000) {		/* if |x| < 2**-27 */
-		if(huge+x>one) return x;/* return x with inexact if x!=0*/
+                /* return x inexact except 0 */
+                if (x != 0) {
+                    fdlibm_setexception(x, FDLIBM_INEXACT);
+                }
+
+                return x;
 	    } else 
 		t = x*x;
 		p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));


=====================================
src/lisp/e_exp.c
=====================================
--- a/src/lisp/e_exp.c
+++ b/src/lisp/e_exp.c
@@ -161,7 +161,12 @@ P5   =  4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */
 	    x  = hi - lo;
 	} 
 	else if(hx < 0x3e300000)  {	/* when |x|<2**-28 */
-	    if(huge+x>one) return one+x;/* trigger inexact */
+            /* return x inexact except 0 */
+            if (x != 0) {
+                fdlibm_setexception(x, FDLIBM_INEXACT);
+            }
+
+            return one + x;
 	}
 	else k = 0;
 


=====================================
tests/fdlibm.lisp
=====================================
--- a/tests/fdlibm.lisp
+++ b/tests/fdlibm.lisp
@@ -106,7 +106,18 @@
     (assert-error ext:double-float-negative-infinity
 		  (kernel:%asinh ext:double-float-negative-infinity)))
   (kernel::with-float-traps-masked (:invalid)
-    (assert-true (ext:float-nan-p (kernel:%asinh *snan*)))))
+    (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))
+  (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 (asinh 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
+		      (asinh x)))))
 
 (define-test %atanh.exceptions
   (:tag :fdlibm)
@@ -176,7 +187,19 @@
 	   (ext:set-floating-point-modes :traps '(:underflow))
 	   (assert-error 'floating-point-underflow
 			 (kernel:%exp -1000d0)))
-      (apply #'ext:set-floating-point-modes modes))))
+      (apply #'ext:set-floating-point-modes modes)))
+  (let ((x (scale-float 1d0 -29))
+	(x0 0d0))
+    ;; exp(x) = x, |x| < 2^-28, with inexact exception unlees x = 0
+    (with-inexact-exception-enabled
+	;; This must not throw an inexact exception because the result
+	;; is exact when the arg is 0.
+	(assert-eql 1d0 (kernel:%exp 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:%exp x)))))
 
 (define-test %log.exception
   (:tag :fdlibm)
@@ -298,16 +321,7 @@
 	(x0 0d0))
     ;; asinh(x) = x for x < 2^-28
     (assert-eql x (asinh x))
-    (assert-eql (- x) (asinh (- x)))
-    (with-inexact-exception-enabled
-	;; This must not throw an inexact exception because the result
-	;; is exact when the arg is 0.
-	(assert-eql 0d0 (asinh 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
-		      (asinh x))))
+    (assert-eql (- x) (asinh (- x))))
   (let ((x (scale-float 1d0 -28)))
     ;; Case 2 > |x| >= 2^-28
     (assert-eql 3.725290298461914d-9 (asinh x))
@@ -556,4 +570,30 @@
   (assert-eql -1d0 (tanh -100d0))
   ;; tanh(1d300), no overflow
   (assert-eql 1d0 (tanh most-positive-double-float))
-  (assert-eql -1d0 (tanh (- most-positive-double-float))))
\ No newline at end of file
+  (assert-eql -1d0 (tanh (- most-positive-double-float))))
+
+(define-test %asin-basic-tests
+    (:tag :fdlibm)
+  (let ((x (scale-float 1d0 -28))
+	(x0 0d0))
+    ;; asin(x) = x for |x| < 2^-27, with inexact exception if x is not 0.
+    (assert-eql x (kernel:%asin x))
+    (assert-eql (- x) (kernel:%asin (- x)))))
+
+(define-test %asin-exception
+    (:tag :fdlibm)
+  (let ((x (scale-float 1d0 -28))
+	(x0 0d0))
+    ;; asin(x) = x for |x| < 2^-27, with inexact exception if x is not 0.
+    (assert-eql x (kernel:%asin x))
+    (assert-eql (- x) (kernel:%asin (- x)))
+    (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:%asin 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:%asin x)))))
+



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0d53bc7f4a6713baf3b601497...

    

Raymond Toy

tags

participants (1)