From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 30 Nov 2018 05:11:35 +0000 (+0000)
Subject: Teach exact->inexact to return infinity rather than crash.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~102
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b7eed211d7e831147bc1c6990b9d25b30a7429ce;p=mit-scheme.git

Teach exact->inexact to return infinity rather than crash.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index b47cd6fbf..807fb1abf 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -959,9 +959,9 @@ USA.
 	(else (slow-method n d))))
 
 (define (int:->inexact n)
-  (if (fixnum? n)
-      (fixnum->flonum n) ;; 8.0 compiler open-codes when is N fixnum (by test)
-      (integer->flonum n #b10)))
+  (cond ((fixnum? n) (fixnum->flonum n))
+	((integer->flonum n #b00))
+	(else (if (int:negative? n) (flo:-inf.0) (flo:+inf.0)))))
 
 (define (flo:significand-digits radix)
   (cond ((int:= radix 10)
diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index def02c895..bc023e694 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -900,16 +900,13 @@ USA.
     (,(- (+ 3 (expt flo:radix flo:precision)))
      ,(- (+ 4 (expt flo:radix. flo:precision))))
     (,(expt flo:radix (+ 1 flo:normal-exponent-max))
-     +inf.0
-     ,expect-error)
+     +inf.0)
     (,(expt flo:radix (* 2 flo:normal-exponent-max))
-     +inf.0
-     ,expect-error)
+     +inf.0)
     (,(- (expt flo:radix (+ 1 flo:normal-exponent-max)))
      -inf.0)
     (,(- (expt flo:radix (* 2 flo:normal-exponent-max)))
-     -inf.0
-     ,expect-error)
+     -inf.0)
     (,(- (expt flo:radix (+ 1 flo:normal-exponent-max))
          (expt flo:radix (- (+ 1 flo:normal-exponent-max) flo:precision)))
      ,flo:largest-positive-normal)