From: Taylor R Campbell Date: Thu, 3 Oct 2019 15:39:13 +0000 (+0000) Subject: Fix bugs in min/max on signalling NaN inputs. X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~39 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2bc5b8f5c2a18513b9232746578c3a08cb0433b2;p=mit-scheme.git Fix bugs in min/max on signalling NaN inputs. --- diff --git a/src/relnotes/bug-minmax b/src/relnotes/bug-minmax index 02e504ed9..d1b14debb 100644 --- a/src/relnotes/bug-minmax +++ b/src/relnotes/bug-minmax @@ -1,5 +1,7 @@ Bug fix: (flo:min x y) and (flo:max x y) now conform to IEEE 754-2008, as minNum/maxNum. -When one input is a NaN, they return the other input. These trap only -when the floating-point invalid-operation exception is trapped. +When one input is a quiet NaN, they return the other input. Only when +both inputs are NaN or one input is a signalling NaN do they return a +NaN, and in either case, it is a quiet NaN. These trap only when the +floating-point invalid-operation exception is trapped. diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm index 31363b65f..942e4d950 100644 --- a/src/runtime/primitive-arithmetic.scm +++ b/src/runtime/primitive-arithmetic.scm @@ -319,22 +319,44 @@ USA. (define (flo:total-mag< x y) (flo:total< (flo:abs x) (flo:abs y))) +(define (flo:quieten-nan n) + (flo:make-nan (flo:sign-negative? n) + #t ;quiet + (flo:nan-payload n))) + (define (flo:invalid-minmax x y caller) caller (cond ((not (flo:nan? x)) (assert (flo:nan? y)) - (if (not (flo:nan-quiet? y)) - (flo:raise-exceptions! (flo:exception:invalid-operation))) - x) + (if (flo:nan-quiet? y) + x + (begin + (flo:raise-exceptions! (flo:exception:invalid-operation)) + (flo:quieten-nan y)))) ((not (flo:nan? y)) (assert (flo:nan? x)) - (if (not (flo:nan-quiet? x)) - (flo:raise-exceptions! (flo:exception:invalid-operation))) - y) + (if (flo:nan-quiet? x) + y + (begin + (flo:raise-exceptions! (flo:exception:invalid-operation)) + (flo:quieten-nan x)))) + ;; Both are NaN. + ((not (or (flo:nan-quiet? x) (flo:nan-quiet? y))) + (flo:raise-exceptions! (flo:exception:invalid-operation)) + (flo:quieten-nan (if (flo:total< x y) x y))) + ((not (flo:nan-quiet? x)) + (flo:raise-exceptions! (flo:exception:invalid-operation)) + (flo:quieten-nan x)) + ((not (flo:nan-quiet? y)) + (flo:raise-exceptions! (flo:exception:invalid-operation)) + (flo:quieten-nan y)) + ;; Both are quiet NaN. (else - (if (not (and (flo:nan-quiet? x) (flo:nan-quiet? y))) - (flo:raise-exceptions! (flo:exception:invalid-operation))) - x))) + ;; The choice is arbitrary; using the minimum in the + ;; standard total ordering keeps the result invariant under + ;; permutation of arguments. (XXX Maybe reverse this for + ;; min vs max?) + (if (flo:total< x y) x y)))) (define (flo:min x y) (cond ((flo:safe< x y) x) diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm index 92a49a86c..1fb25591b 100644 --- a/tests/runtime/test-flonum.scm +++ b/tests/runtime/test-flonum.scm @@ -1042,78 +1042,54 @@ USA. (assert-eqv-nan (yes-traps (lambda () (flo:max-mag x y))) max-mag))) (define-enumerated-test 'min-snan-left inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:min (flo:snan 123) x))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:min (flo:snan 123) x))) + (flo:qnan 123)))) (define-enumerated-test 'max-snan-left inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:max (flo:snan 123) x))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:max (flo:snan 123) x))) + (flo:qnan 123)))) (define-enumerated-test 'min-snan-right inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:min x (flo:snan 123)))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:min x (flo:snan 123)))) + (flo:qnan 123)))) (define-enumerated-test 'max-snan-right inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:max x (flo:snan 123)))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:max x (flo:snan 123)))) + (flo:qnan 123)))) (define-test 'min-snan-both (lambda () - (expect-failure - (lambda () - (assert-qnan - (no-traps (lambda () (flo:min (flo:snan 123) (flo:snan 456))))))))) + (assert-qnan + (no-traps (lambda () (flo:min (flo:snan 123) (flo:snan 456))))))) (define-test 'max-snan-both (lambda () - (expect-failure - (lambda () - (assert-qnan - (no-traps (lambda () (flo:max (flo:snan 123) (flo:snan 456))))))))) + (assert-qnan + (no-traps (lambda () (flo:max (flo:snan 123) (flo:snan 456))))))) (define-enumerated-test 'min-mag-snan-left inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:min-mag (flo:snan 123) x))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:min-mag (flo:snan 123) x))) + (flo:qnan 123)))) (define-enumerated-test 'max-mag-snan-left inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:max-mag (flo:snan 123) x))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:max-mag (flo:snan 123) x))) + (flo:qnan 123)))) (define-enumerated-test 'min-mag-snan-right inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:min-mag x (flo:snan 123)))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:min-mag x (flo:snan 123)))) + (flo:qnan 123)))) (define-enumerated-test 'max-mag-snan-right inputs (lambda (x) - (expect-failure - (lambda () - (assert-eqv-nan (no-traps (lambda () (flo:max-mag x (flo:snan 123)))) - (flo:qnan 123)))))) + (assert-eqv-nan (no-traps (lambda () (flo:max-mag x (flo:snan 123)))) + (flo:qnan 123)))) (define-test 'min-mag-snan-both (lambda () - (expect-failure - (lambda () - (assert-qnan - (no-traps - (lambda () (flo:min-mag (flo:snan 123) (flo:snan 456))))))))) + (assert-qnan + (no-traps + (lambda () (flo:min-mag (flo:snan 123) (flo:snan 456))))))) (define-test 'max-mag-snan-both (lambda () - (expect-failure - (lambda () - (assert-qnan - (no-traps - (lambda () (flo:max-mag (flo:snan 123) (flo:snan 456)))))))))) + (assert-qnan + (no-traps + (lambda () (flo:max-mag (flo:snan 123) (flo:snan 456)))))))) (define-enumerated-test 'abs `((-inf.0)