[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-08-29-g3bc0f53

[Raymond Toy]

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  3bc0f535ff91082cbb7a207a5d50b1c5045ffaa0 (commit)
      from  63929ee776996a45c97444ffe807316ae6187e3c (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 3bc0f535ff91082cbb7a207a5d50b1c5045ffaa0
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Aug 23 08:31:46 2014 -0700

    Make inverse trig signal errors using fdlibm_setexception.
    
     * src/lisp/e_acos.c
       * Use fdlibm_setexception
     * src/lisp/e_asin.c
       * Use fdlibm_setexception
     * src/lisp/s_atan.c
       * Use fdlibm_setexception
     * tests/trig.lisp:
       * Add tests for acos, asin, and atan.

diff --git a/src/lisp/e_acos.c b/src/lisp/e_acos.c
index bd54a04..2dc1eb9 100644
--- a/src/lisp/e_acos.c
+++ b/src/lisp/e_acos.c
@@ -76,7 +76,8 @@ qS4 =  7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
 		if(hx>0) return 0.0;		/* acos(1) = 0  */
 		else return pi+2.0*pio2_lo;	/* acos(-1)= pi */
 	    }
-	    return (x-x)/(x-x);		/* acos(|x|>1) is NaN */
+            /* acos(|x|>1) is NaN */
+	    return fdlibm_setexception(x, FDLIBM_INVALID);
 	}
 	if(ix<0x3fe00000) {	/* |x| < 0.5 */
 	    if(ix<=0x3c600000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/
diff --git a/src/lisp/e_asin.c b/src/lisp/e_asin.c
index 4aa6c63..af945fe 100644
--- a/src/lisp/e_asin.c
+++ b/src/lisp/e_asin.c
@@ -85,7 +85,8 @@ qS4 =  7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
 	    if(((ix-0x3ff00000)|ux.i[LOWORD])==0)
 		    /* asin(1)=+-pi/2 with inexact */
 		return x*pio2_hi+x*pio2_lo;	
-	    return (x-x)/(x-x);		/* asin(|x|>1) is NaN */   
+            /* asin(|x|>1) is NaN */
+	    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*/
diff --git a/src/lisp/s_atan.c b/src/lisp/s_atan.c
index 003f057..f16c4b5 100644
--- a/src/lisp/s_atan.c
+++ b/src/lisp/s_atan.c
@@ -99,7 +99,7 @@ huge   = 1.0e300;
 	if(ix>=0x44100000) {	/* if |x| >= 2^66 */
 	    if(ix>0x7ff00000||
 		(ix==0x7ff00000&&(ux.i[LOWORD]!=0)))
-		return x+x;		/* NaN */
+                return fdlibm_setexception(x, FDLIBM_INVALID);  /* NaN */
 	    if(hx>0) return  atanhi[3]+atanlo[3];
 	    else     return -atanhi[3]-atanlo[3];
 	} if (ix < 0x3fdc0000) {	/* |x| < 0.4375 */
diff --git a/tests/trig.lisp b/tests/trig.lisp
index 1b6102d..62f6f91 100644
--- a/tests/trig.lisp
+++ b/tests/trig.lisp
@@ -906,7 +906,6 @@
 		  (kernel:%atanh 1d0))
     (assert-equal ext:double-float-negative-infinity
 		  (kernel:%atanh -1d0))))
-    
 
 (define-test expm1.exceptions
   (:tag :fdlibm)
@@ -969,3 +968,31 @@
   (kernel::with-float-traps-masked (:invalid)
     (assert-true (ext:float-nan-p (kernel:%log -1d0)))
     (assert-true (ext:float-nan-p (kernel:%log *snan*)))))
+
+(define-test acos.exceptions
+  (:tag :fdlibm)
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%acos 2d0))
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%acos -2d0))
+  (kernel::with-float-traps-masked (:invalid)
+    (assert-true (ext:float-nan-p (kernel:%acos 2d0)))
+    (assert-true (ext:float-nan-p (kernel:%acos -2d0)))))
+
+(define-test asin.exceptions
+  (:tag :fdlibm)
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%asin 2d0))
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%asin -2d0))
+  (kernel::with-float-traps-masked (:invalid)
+    (assert-true (ext:float-nan-p (kernel:%asin 2d0)))
+    (assert-true (ext:float-nan-p (kernel:%asin -2d0)))))
+
+(define-test atan.exceptions
+  (:tag :fdlibm)
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%atan *snan*))
+  (assert-true (ext:float-nan-p (kernel:%atan *qnan*)))
+  (kernel::with-float-traps-masked (:invalid)
+    (assert-true (ext:float-nan-p (kernel:%atan *snan*)))))

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

Summary of changes:
 src/lisp/e_acos.c |    3 ++-
 src/lisp/e_asin.c |    3 ++-
 src/lisp/s_atan.c |    2 +-
 tests/trig.lisp   |   29 ++++++++++++++++++++++++++++-
 4 files changed, 33 insertions(+), 4 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp