From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 30 Nov 2018 00:53:48 +0000 (+0000)
Subject: Test flo:negate.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~118
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9ce02e6ac7fc4011e8db7fd1309e5032049d235e;p=mit-scheme.git

Test flo:negate.
---

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 0f692fe87..39216e0b8 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -927,6 +927,42 @@ USA.
                 (assert-eqv (flo:nan-quiet? x) (flo:nan-quiet? y))
                 (assert-eqv (flo:nan-payload x) (flo:nan-payload y)))))))))
 
+(define-enumerated-test 'negate
+  `((-inf.0 +inf.0)
+    (-1. +1.)
+    (-0. +0.)
+    (+0. -0.)
+    (+1. -1.)
+    (+inf.0 -inf.0)
+    (,(flo:make-nan #t #t 0) ,(flo:make-nan #f #t 0))
+    (,(flo:make-nan #f #t 0) ,(flo:make-nan #t #t 0))
+    (,(flo:make-nan #t #t 1) ,(flo:make-nan #f #t 1))
+    (,(flo:make-nan #f #t 1) ,(flo:make-nan #t #t 1))
+    (,(flo:make-nan #t #t (- (expt 2 51) 1))
+     ,(flo:make-nan #f #t (- (expt 2 51) 1)))
+    (,(flo:make-nan #f #t (- (expt 2 51) 1))
+     ,(flo:make-nan #t #t (- (expt 2 51) 1)))
+    (,(flo:make-nan #t #f 1) ,(flo:make-nan #f #f 1))
+    (,(flo:make-nan #f #f 1) ,(flo:make-nan #t #f 1))
+    (,(flo:make-nan #t #f (- (expt 2 51) 1))
+     ,(flo:make-nan #f #f (- (expt 2 51) 1)))
+    (,(flo:make-nan #f #f (- (expt 2 51) 1))
+     ,(flo:make-nan #t #f (- (expt 2 51) 1))))
+  (lambda (x z #!optional xfail)
+    (with-expected-failure xfail
+      (lambda ()
+        (let ((y (yes-traps (lambda () (flo:negate x)))))
+          (assert-eqv-nan y z)
+          (assert-eqv-nan (flo:abs x) (flo:abs y))
+          (assert-eqv (flo:safe-negative? y)
+                      (not (flo:safe-negative? x)))
+          (assert-eqv (flo:classify y) (flo:classify x))
+          (if (flo:nan? x)
+              (begin
+                (assert-nan y)
+                (assert-eqv (flo:nan-quiet? x) (flo:nan-quiet? y))
+                (assert-eqv (flo:nan-payload x) (flo:nan-payload y)))))))))
+
 (let ((cases
        (vector (flo:make-nan #t #t 0)
                (flo:make-nan #t #t 1)