From 0fcc5f55142d7de7d4af8a1027264e31576673a7 Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 29 Nov 2018 02:05:51 +0000
Subject: [PATCH] Use fabs(3) for C implementation of FLONUM-ABS.

A conditional based on < doesn't handle NaN correctly.
---
 src/microcode/flonum.c        |  2 +-
 src/relnotes/bug-floabs       |  2 ++
 tests/runtime/test-flonum.scm | 28 ++++++++--------------------
 3 files changed, 11 insertions(+), 21 deletions(-)
 create mode 100644 src/relnotes/bug-floabs

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 ()
-- 
2.25.1