From 435b38bd8bbf1d7764b06401a6d19b92a23b749f Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 18 Nov 2018 01:38:28 +0000
Subject: [PATCH] Fix 0 * inf.
---
src/runtime/arith.scm | 12 ++++++++++--
tests/runtime/test-arith.scm | 2 +-
2 files changed, 11 insertions(+), 3 deletions(-)
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
--
2.25.1