From 435b38bd8bbf1d7764b06401a6d19b92a23b749f Mon Sep 17 00:00:00 2001 From: Taylor R Campbell 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