Raise the appropriate exceptions in exact->exact.

- inexact-result if result is changed by rounding
- overflow if result is infinite.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 807fb1abf1eb1fa74be740515ea30b41e9d16db3..38dfb04ce31f5d0401f8648b818438a2228317b1 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -959,9 +959,20 @@ USA.
        (else (slow-method n d))))
 
 (define (int:->inexact n)
-  (cond ((fixnum? n) (fixnum->flonum n))
-       ((integer->flonum n #b00))
-       (else (if (int:negative? n) (flo:-inf.0) (flo:+inf.0)))))
+  (cond ((fixnum? n)
+        ;; The primitive (via hardware) will raise inexact if necessary.
+        (fixnum->flonum n))
+       ((integer->flonum n #b00)
+        => (lambda (x)
+             ;; The primitive does not always raise inexact for us,
+             ;; though it does raise overflow.
+             (if (not (and (flo:finite? x) (int:= (flo:->integer x) n)))
+                 (flo:raise-exceptions! (flo:exception:inexact-result)))
+             x))
+       (else
+        (flo:raise-exceptions!
+         (fix:or (flo:exception:overflow) (flo:exception:inexact-result)))
+        (if (int:negative? n) (flo:-inf.0) (flo:+inf.0)))))
 \f
 (define (flo:significand-digits radix)
   (cond ((int:= radix 10)

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 7c7d027e54115f14c5dd5346251e5b0c52ec6c4c..d4d8ff899fc77f8f14f325d1af00535d2109bf79 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -902,19 +902,13 @@ USA.
     (,(- (+ 3 (expt flo:radix flo:precision)))
      ,(- (+ 4 (expt flo:radix. flo:precision))))
     (,(expt flo:radix (+ 1 flo:normal-exponent-max))
-     +inf.0
-     ;; Missing overflow exception.
-     ,expect-failure)
+     +inf.0)
     (,(expt flo:radix (* 2 flo:normal-exponent-max))
-     +inf.0
-     ;; Missing overflow exception.
-     ,expect-failure)
+     +inf.0)
     (,(- (expt flo:radix (+ 1 flo:normal-exponent-max)))
      -inf.0)
     (,(- (expt flo:radix (* 2 flo:normal-exponent-max)))
-     -inf.0
-     ;; Missing overflow exception.
-     ,expect-failure)
+     -inf.0)
     (,(- (expt flo:radix (+ 1 flo:normal-exponent-max))
          (expt flo:radix (- (+ 1 flo:normal-exponent-max) flo:precision)))
      ,flo:largest-positive-normal)
@@ -939,9 +933,7 @@ USA.
     (,(- (* (expt flo:radix (+ 1 flo:normal-exponent-max))
             (- 1 (expt flo:radix (- flo:precision))))
          1)
-     ,flo:largest-positive-normal
-     ;; Missing inexact-result exception.
-     ,expect-failure)
+     ,flo:largest-positive-normal)
     (,(- (* (expt flo:radix (+ 1 flo:normal-exponent-max))
             (- 1 (expt flo:radix (- flo:precision)))))
      -inf.0
@@ -956,9 +948,7 @@ USA.
     (,(- (- (* (expt flo:radix (+ 1 flo:normal-exponent-max))
                (- 1 (expt flo:radix (- flo:precision))))
             1))
-     ,(- flo:largest-positive-normal)
-     ;; Missing inexact-result exception.
-     ,expect-failure))
+     ,(- flo:largest-positive-normal)))
   (lambda (x y #!optional xfail)
     (assert-exact x)
     (assert-inexact y)