From df33581ec46f850f755098452f504ebf9323ab25 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Fri, 30 Nov 2018 05:49:03 +0000 Subject: [PATCH] Raise the appropriate exceptions in exact->exact. - inexact-result if result is changed by rounding - overflow if result is infinite. --- src/runtime/arith.scm | 17 ++++++++++++++--- tests/runtime/test-arith.scm | 20 +++++--------------- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm index 807fb1abf..38dfb04ce 100644 --- 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))))) (define (flo:significand-digits radix) (cond ((int:= radix 10) diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm index 7c7d027e5..d4d8ff899 100644 --- 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) -- 2.25.1