X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffloat.pure.lisp;h=a7d8e344401cbc5e7caf6898586b1d534e7eedde;hb=c3af3cf3704ce01c71de96cc36c2798014fc9960;hp=7b9502c4000ce5684333acc4dd0ef8326ec164d5;hpb=4c81c652cdc32faefee1bccb84c3c9a7854e3edd;p=sbcl.git

diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index 7b9502c..a7d8e34 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -93,7 +93,7 @@
 (assert (= 0.0d0 (scale-float 1.0d0 (1- most-negative-fixnum))))
 
 (with-test (:name (:scale-float-overflow :bug-372)
-            :fails-on :darwin) ;; bug 372
+            :fails-on '(and :darwin (or :ppc :x86))) ;; bug 372
   (progn
     (assert (raises-error? (scale-float 1.0 most-positive-fixnum)
                            floating-point-overflow))
@@ -125,7 +125,28 @@
 (funcall (compile nil '(lambda () (tan (tan (round 0))))))
 
 (with-test (:name (:addition-overflow :bug-372)
-            :fails-on '(or (and :ppc :openbsd) :darwin (and :x86 :netbsd)))
+            :fails-on '(or (and :ppc :openbsd)
+                           (and (or :ppc :x86) :darwin)
+                           (and :x86 :netbsd)))
+  (assert (typep (nth-value
+                  1
+                  (ignore-errors
+                    (sb-sys:without-interrupts
+                     (sb-int:set-floating-point-modes :current-exceptions nil
+                                                      :accrued-exceptions nil)
+                     (loop repeat 2 summing most-positive-double-float)
+                     (sleep 2))))
+                 'floating-point-overflow)))
+
+;; This is the same test as above.  Even if the above copy passes,
+;; this copy will fail if SIGFPE handling ends up clearing the FPU
+;; control word, which can happen if the kernel clears the FPU control
+;; (a reasonable thing for it to do) and the runtime fails to
+;; compensate for this (see RESTORE_FP_CONTROL_WORD in interrupt.c).
+(with-test (:name (:addition-overflow :bug-372 :take-2)
+            :fails-on '(or (and :ppc :openbsd)
+                           (and (or :ppc :x86) :darwin)
+                           (and :x86 :netbsd)))
   (assert (typep (nth-value
                   1
                   (ignore-errors
@@ -249,7 +270,8 @@
 ;;   The x86 port used not to reduce the arguments of transcendentals
 ;;   correctly. On other platforms, we trust libm to DTRT.
 ;; but it doesn't cost any real amount to just test them all
-(with-test (:name :range-reduction)
+(with-test (:name :range-reduction
+            :fails-on ':x86-64)
   (flet ((almost= (x y)
            (< (abs (- x y)) 1d-5)))
     (macrolet ((foo (op value)
@@ -372,3 +394,15 @@
                (+ (float int 0e0) x0))))
       (declare (notinline test-cvtsi2ss))
       (assert (zerop (imagpart (test-cvtsi2ss 4)))))))
+
+(with-test (:name :round-to-bignum)
+  (assert (= (round 1073741822.3d0) 1073741822))
+  (assert (= (round 1073741822.5d0) 1073741822))
+  (assert (= (round 1073741822.7d0) 1073741823))
+  (assert (= (round 1073741823.3d0) 1073741823))
+  (assert (= (round 1073741823.5d0) 1073741824))
+  (assert (= (round 1073741823.7d0) 1073741824)))
+
+(with-test (:name :round-single-to-bignum)
+  (assert (= (round 1e14) 100000000376832))
+  (assert (= (round 1e19) 9999999980506447872)))