Fix flo:ulp on NaN.

diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm
index d893e37ef06b100c09fa81fb18d56b51eead477d..0c5a7c4fb3d22d1799c25cce08a2a04b3567d98e 100644 (file)
--- a/src/runtime/primitive-arithmetic.scm
+++ b/src/runtime/primitive-arithmetic.scm
@@ -375,11 +375,13 @@ USA.
 ;;; this yields some NaN.
 
 (define (flo:ulp x)
-  (if (flo:finite? x)
-      (let* ((x0 (flo:abs x))
-             (x1 (flo:nextafter x0 (flo:+inf.0))))
-        (flo:- x1 x0))
-      (flo:+inf.0)))
+  (cond ((flo:finite? x)
+        (let* ((x0 (flo:abs x))
+               (x1 (flo:nextafter x0 (flo:+inf.0))))
+          (flo:- x1 x0)))
+       ((flo:infinite? x)
+        (flo:+inf.0))
+       (else x)))
 
 (define (int:->flonum n)
   ((ucode-primitive integer->flonum 2) n #b10))

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index af2d12598e7fb09723bdb6bfdf2222a998caea76..5c3db4ecb73c92922e3a6fcc0422e957035345ed 100644 (file)
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -236,7 +236,7 @@ USA.
    (list 3. (* 2 flo:ulp-of-one))
    (list (- 3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
    (list (flo:+inf.0) (flo:+inf.0))
-   (list +nan.123 +nan.123 expect-failure))
+   (list +nan.123 +nan.123))
   (lambda (x u #!optional xfail)
     (flo:with-trapped-exceptions 0
       (lambda ()