From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 29 Nov 2018 02:05:51 +0000 (+0000)
Subject: Use fabs(3) for C implementation of FLONUM-ABS.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~132
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0fcc5f55142d7de7d4af8a1027264e31576673a7;p=mit-scheme.git

Use fabs(3) for C implementation of FLONUM-ABS.

A conditional based on < doesn't handle NaN correctly.
---

diff --git a/src/microcode/flonum.c b/src/microcode/flonum.c
index 4b24e1d7e..d6330b968 100644
--- a/src/microcode/flonum.c
+++ b/src/microcode/flonum.c
@@ -103,7 +103,7 @@ DEFINE_PRIMITIVE ("FLONUM-ABS", Prim_flonum_abs, 1, 1, 0)
   PRIMITIVE_HEADER (1);
   {
     double x = (arg_flonum (1));
-    FLONUM_RESULT ((x < 0) ? (-x) : x);
+    FLONUM_RESULT (fabs (x));
   }
 }
 
diff --git a/src/relnotes/bug-floabs b/src/relnotes/bug-floabs
new file mode 100644
index 000000000..e10ab01bd
--- /dev/null
+++ b/src/relnotes/bug-floabs
@@ -0,0 +1,2 @@
+Bug fix: abs now always correctly adjusts the sign of a NaN and never
+raises a floating-point exception, following IEEE 754-2008.
diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index c2ae94400..0ce0b0c92 100644
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -625,35 +625,23 @@ USA.
       (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.)
     (+0.)
     (+1.)
     (+inf.0)
-    (,(flo:make-nan #t #t 0) ,expect-failure-interpreted)
+    (,(flo:make-nan #t #t 0))
     (,(flo:make-nan #f #t 0))
-    (,(flo:make-nan #t #t 1) ,expect-failure-interpreted)
+    (,(flo:make-nan #t #t 1))
     (,(flo:make-nan #f #t 1))
-    (,(flo:make-nan #t #t (- (expt 2 51) 1)) ,expect-failure-interpreted)
+    (,(flo:make-nan #t #t (- (expt 2 51) 1)))
     (,(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))
+    (,(flo:make-nan #t #f 1))
+    (,(flo:make-nan #f #f 1))
+    (,(flo:make-nan #t #f (- (expt 2 51) 1)))
+    (,(flo:make-nan #f #f (- (expt 2 51) 1))))
   (lambda (x #!optional xfail)
     (with-expected-failure xfail
       (lambda ()