Fix bugs in min/max on signalling NaN inputs.

diff --git a/src/relnotes/bug-minmax b/src/relnotes/bug-minmax
index 02e504ed9f958700c3de3788a1bbb8558ac5cbd7..d1b14debbf1dc19ab13772472558aefad92669bb 100644 (file)
--- 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 31363b65f556c070063dd539ae3362cf3e642f17..942e4d950ff4a5da612bf863335a8f16f8bcda57 100644 (file)
--- 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)))
 \f
+(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 92a49a86ce118bd9b9bbf9cc1dcc6bbf26161790..1fb25591b2b6b78a541af7d1ae552737f00241a1 100644 (file)
--- 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)