From 885260d2e2dc506342ff8ca8570ac79f2b7a9be0 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sun, 30 Jun 2019 19:50:12 +0000 Subject: [PATCH] Fix flo:ulp on NaN. --- src/runtime/primitive-arithmetic.scm | 12 +++++++----- tests/runtime/test-flonum.scm | 2 +- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm index d893e37ef..0c5a7c4fb 100644 --- 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 af2d12598..5c3db4ecb 100644 --- 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 () -- 2.25.1