From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 29 Nov 2018 02:02:22 +0000 (+0000)
Subject: Our C implementation of flo:abs is busted.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~133
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e5decff5ed30bb7af1297a42569a481676044d86;p=mit-scheme.git

Our C implementation of flo:abs is busted.
---

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 3ff6e1f5c..c2ae94400 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -624,3 +624,44 @@ USA.
     (lambda ()
       (assert-nan
        (no-traps (lambda () (flo:max-mag (flo:snan) (flo:snan))))))))
+
+(define expect-failure-interpreted
+  (if (and (compiled-procedure? (lambda (x) x))
+           (compiled-procedure? flo:abs))
+      #!default
+      expect-failure))
+
+(define expect-error-interpreted
+  (if (and (compiled-procedure? (lambda (x) x))
+           (compiled-procedure? flo:abs))
+      #!default
+      expect-error))
+
+(define-enumerated-test 'abs
+  `((-inf.0)
+    (-1.)
+    (-0. ,expect-failure-interpreted)
+    (+0.)
+    (+1.)
+    (+inf.0)
+    (,(flo:make-nan #t #t 0) ,expect-failure-interpreted)
+    (,(flo:make-nan #f #t 0))
+    (,(flo:make-nan #t #t 1) ,expect-failure-interpreted)
+    (,(flo:make-nan #f #t 1))
+    (,(flo:make-nan #t #t (- (expt 2 51) 1)) ,expect-failure-interpreted)
+    (,(flo:make-nan #f #t (- (expt 2 51) 1)))
+    (,(flo:make-nan #t #f 1) ,expect-error-interpreted)
+    (,(flo:make-nan #f #f 1) ,expect-error-interpreted)
+    (,(flo:make-nan #t #f (- (expt 2 51) 1)) ,expect-error-interpreted)
+    (,(flo:make-nan #f #f (- (expt 2 51) 1)) ,expect-error-interpreted))
+  (lambda (x #!optional xfail)
+    (with-expected-failure xfail
+      (lambda ()
+        (let ((y (yes-traps (lambda () (flo:abs x)))))
+          (assert-false (flo:safe-negative? y))
+          (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)))))))))