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

[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  86790380313712fb5ca6134427c381e40a71d233 (commit)
      from  258101b2bc45125f6bd72dc2a1cf56e6baab821b (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 86790380313712fb5ca6134427c381e40a71d233
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Tue Aug 19 22:25:16 2014 -0700

    Ensure acosh signals appropriate exceptions.
    
     * src/lisp/e_acosh.c:
       * Use fdlibm_setexceptions to signal exceptions appropriately.
     * tests/trig.lisp:
       * Add tests for acosh.
       * Update other tests to use the kernel:%foo functions instead of
         calling CL:foo. We really want to just test the fdlibm functions,
         not the CL versions of them, which might have different
         definitions. For example, acosh is defined for all real args
         (returning complex numbers in some cases), but kernel:%acosh is
         only defined for x > 1.

diff --git a/src/lisp/e_acosh.c b/src/lisp/e_acosh.c
index fb248d5..86e43f9 100644
--- a/src/lisp/e_acosh.c
+++ b/src/lisp/e_acosh.c
@@ -50,10 +50,16 @@ ln2	= 6.93147180559945286227e-01;  /* 0x3FE62E42, 0xFEFA39EF */
         ux.d = x;
 	hx = ux.i[HIWORD];
 	if(hx<0x3ff00000) {		/* x < 1 */
-	    return (x-x)/(x-x);
+            return fdlibm_setexception(x, FDLIBM_INVALID);
 	} else if(hx >=0x41b00000) {	/* x > 2**28 */
 	    if(hx >=0x7ff00000) {	/* x is inf of NaN */
-	        return x+x;
+                if ((hx == 0x7ff00000) && (ux.i[LOWORD] == 0)) {
+                    /* Overflow if x is +inf. */
+                    return fdlibm_setexception(x, FDLIBM_OVERFLOW);
+                } else {
+                    /* Invalid if x is NaN */
+                    return fdlibm_setexception(x, FDLIBM_INVALID);
+                }
 	    } else 
 		return __ieee754_log(x)+ln2;	/* acosh(huge)=log(2x) */
 	} else if(((hx-0x3ff00000)|ux.i[LOWORD])==0) {
diff --git a/tests/trig.lisp b/tests/trig.lisp
index 18c9199..62ac377 100644
--- a/tests/trig.lisp
+++ b/tests/trig.lisp
@@ -802,46 +802,61 @@
 (define-test cosh.exceptions
   (:tag :fdlibm)
   (assert-error 'floating-point-overflow
-		(cosh 1000d0))
+		(kernel:%cosh 1000d0))
   (assert-error 'floating-point-overflow
-		(cosh -1000d0))
+		(kernel:%cosh -1000d0))
   (assert-error 'floating-point-invalid-operation
-		(cosh *nan*))
+		(kernel:%cosh *nan*))
   ;; Same, but with overflow's masked
   (kernel::with-float-traps-masked (:overflow)
     (assert-equal ext:double-float-positive-infinity
-		  (cosh 1000d0))
+		  (kernel:%cosh 1000d0))
     (assert-equal ext:double-float-positive-infinity
-		  (cosh -1000d0))
+		  (kernel:%cosh -1000d0))
     (assert-equal ext:double-float-positive-infinity
-		  (cosh ext:double-float-positive-infinity))
+		  (kernel:%cosh ext:double-float-positive-infinity))
     (assert-equal ext:double-float-positive-infinity
-		  (cosh ext:double-float-negative-infinity)))
+		  (kernel:%cosh ext:double-float-negative-infinity)))
   ;; Test NaN
   (kernel::with-float-traps-masked (:invalid)
-    (assert-true (ext:float-nan-p (cosh *nan*)))))
+    (assert-true (ext:float-nan-p (kernel:%cosh *nan*)))))
 
-(define-test sinh.overflow
+(define-test sinh.exceptions
   (:tag :fdlibm)
   (assert-error 'floating-point-overflow
-		(sinh 1000d0))
+		(kernel:%sinh 1000d0))
   (assert-error 'floating-point-overflow
-		(sinh -1000d0))
+		(kernel:%sinh -1000d0))
   (assert-error 'floating-point-invalid-operation
-		(sinh *nan*))
+		(kernel:%sinh *nan*))
   ;; Same, but with overflow's masked
   (kernel::with-float-traps-masked (:overflow)
     (assert-equal ext:double-float-positive-infinity
-		  (sinh 1000d0))
+		  (kernel:%sinh 1000d0))
     (assert-equal ext:double-float-negative-infinity
-		  (sinh -1000d0))
+		  (kernel:%sinh -1000d0))
     (assert-equal ext:double-float-positive-infinity
-		  (sinh ext:double-float-positive-infinity))
+		  (kernel:%sinh ext:double-float-positive-infinity))
     (assert-equal ext:double-float-negative-infinity
-		  (sinh ext:double-float-negative-infinity)))
+		  (kernel:%sinh ext:double-float-negative-infinity)))
   ;; Test NaN
   (kernel::with-float-traps-masked (:invalid)
-    (assert-true (ext:float-nan-p (sinh *nan*)))))
+    (assert-true (ext:float-nan-p (kernel:%sinh *nan*)))))
 
 
+(define-test tanh.exceptions
+  (:tag :fdlibm)
+  (assert-true (ext:float-nan-p (kernel:%tanh *nan*))))
 
+(define-test acosh.exceptions
+  (:tag :fdlibm)
+  (assert-error 'floating-point-overflow
+		(kernel:%acosh ext:double-float-positive-infinity))
+  (assert-error 'floating-point-invalid-operation
+		(kernel:%acosh 0d0))
+  (kernel::with-float-traps-masked (:overflow)
+    (assert-equal ext:double-float-positive-infinity
+		  (kernel:%acosh ext:double-float-positive-infinity)))
+  (kernel::with-float-traps-masked (:invalid)
+    (assert-true (ext:float-nan-p (kernel:%acosh 0d0)))))
+  

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

Summary of changes:
 src/lisp/e_acosh.c |   10 ++++++++--
 tests/trig.lisp    |   49 ++++++++++++++++++++++++++++++++-----------------
 2 files changed, 40 insertions(+), 19 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp