Fix 0 * inf.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index ba54034a727727c01d99970391a4663ca89377da..03b1cacac547d078b2b18daeef2666ffe47929e6 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1059,9 +1059,17 @@ USA.
 (define (real:* x y)
   (cond ((flonum? x)
         (cond ((flonum? y) (flo:* x y))
-              ((rat:zero? y) (if (flo:nan? x) x y))
+              ((rat:zero? y)
+               (cond ((flo:finite? x) y)
+                     ((flo:nan? x) x)
+                     (else (flo:* x 0.))))
               (else (flo:* x (rat:->inexact y)))))
-       ((rat:zero? x) (if (and (flonum? y) (flo:nan? y)) y x))
+       ((rat:zero? x)
+        (if (flonum? y)
+            (cond ((flo:finite? y) x)
+                  ((flo:nan? y) y)
+                  (else (flo:* 0. y)))
+            x))
        ((flonum? y) (flo:* (rat:->inexact x) y))
        (else ((copy rat:*) x y))))
 

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 3d634288c17879f7da4ebfda021aba6432f3d9b0..333383941670cd2434025979509e84d35cf23bb2 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -132,7 +132,7 @@ USA.
           (list (flo:+inf.0) 0)
           (list (flo:-inf.0) 0))
   (lambda (l)
-    (expect-failure (lambda () (assert-nan (apply * l))))))
+    (assert-nan (apply * l))))
 
 (define-enumerated-test 'flo:ulp
   (vector