From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 18 Nov 2018 01:38:28 +0000 (+0000)
Subject: Fix 0 * inf.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~51
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=435b38bd8bbf1d7764b06401a6d19b92a23b749f;p=mit-scheme.git

Fix 0 * inf.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index ba54034a7..03b1cacac 100644
--- 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 3d634288c..333383941 100644
--- 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