suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix reading of extflonums, including with large exponents

Browse Source 
Fix even basic readind when extflonums are not supported, but
also fix reading extflonums with large exponents (related to
the other recent changes to number parsing).
This commit is contained in:
Matthew Flatt 2015-11-21 10:42:42 -07:00
parent 9d2dd01689
commit c40229f756
2 changed files with 34 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -3,6 +3,8 @@
(Section 'numbers) (Section 'numbers)
(require racket/extflonum)
(test #f number? 'a) (test #f number? 'a)
(test #f complex? 'a) (test #f complex? 'a)
(test #f real? 'a) (test #f real? 'a)
@ -2404,6 +2406,9 @@
(err/rt-test (string->number "1" "1")) (err/rt-test (string->number "1" "1"))
(err/rt-test (string->number 1 1)) (err/rt-test (string->number 1 1))
(define (string->extfl-number s)
(read (open-input-string s)))
;; Test inexacts with large exponents ;; Test inexacts with large exponents
(test 0.0 string->number "0e401") (test 0.0 string->number "0e401")
(test 0.0 string->number "0e6001") (test 0.0 string->number "0e6001")
@ -2415,8 +2420,10 @@
(test -inf.0 string->number "-0.1e6001") (test -inf.0 string->number "-0.1e6001")
(test 0.0 string->number (string-append "0." (make-string 400 #\0) "0e400")) (test 0.0 string->number (string-append "0." (make-string 400 #\0) "0e400"))
(test 0.0 string->number (string-append "0." (make-string 8000 #\0) "0e8000")) (test 0.0 string->number (string-append "0." (make-string 8000 #\0) "0e8000"))
(test #t extflonum? (string->extfl-number (string-append "0." (make-string 400 #\0) "0t9000")))
(test -0.0 string->number (string-append "-0." (make-string 400 #\0) "0e400")) (test -0.0 string->number (string-append "-0." (make-string 400 #\0) "0e400"))
(test -0.0 string->number (string-append "-0." (make-string 8000 #\0) "0e8000")) (test -0.0 string->number (string-append "-0." (make-string 8000 #\0) "0e8000"))
(test #t extflonum? (string->extfl-number (string-append "-0." (make-string 400 #\0) "0t9000")))
(test 0.1 string->number (string-append "0." (make-string 400 #\0) "1e400")) (test 0.1 string->number (string-append "0." (make-string 400 #\0) "1e400"))
(test 0.1 string->number (string-append "0." (make-string 8000 #\0) "1e8000")) (test 0.1 string->number (string-append "0." (make-string 8000 #\0) "1e8000"))
(test 1.0e-101 string->number (string-append "0." (make-string 8000 #\0) "1e7900")) (test 1.0e-101 string->number (string-append "0." (make-string 8000 #\0) "1e7900"))
@ -2424,6 +2431,8 @@
(test -inf.0 string->number (string-append "-0." (make-string 400 #\0) "1e1000")) (test -inf.0 string->number (string-append "-0." (make-string 400 #\0) "1e1000"))
(test +inf.0 string->number (string-append "0." (make-string 8000 #\0) "1e8400")) (test +inf.0 string->number (string-append "0." (make-string 8000 #\0) "1e8400"))
(test -inf.0 string->number (string-append "-0." (make-string 8000 #\0) "1e8400")) (test -inf.0 string->number (string-append "-0." (make-string 8000 #\0) "1e8400"))
(test #t extflonum? (string->extfl-number (string-append "0." (make-string 8000 #\0) "1t8400")))
(test #t extflonum? (string->extfl-number (string-append "-0." (make-string 8000 #\0) "1t8400")))
(test #f string->number (string-append "-0." (make-string 8000 #\0) "9e10000") 8) (test #f string->number (string-append "-0." (make-string 8000 #\0) "9e10000") 8)
(test #f string->number (string-append "0." (make-string 8000 #\0) "e1008") 8) (test #f string->number (string-append "0." (make-string 8000 #\0) "e1008") 8)
@ -3190,8 +3199,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; exact->inexact precision (thanks to Neil Toronto) ;; exact->inexact precision (thanks to Neil Toronto)
(require racket/extflonum)
(define (check start end exact-> ->exact >=?) (define (check start end exact-> ->exact >=?)
(define delta (/ (- end start) 300)) (define delta (/ (- end start) 300))
(for/fold ([prev (exact-> start)]) ([i (in-range start (+ end delta) delta)]) (for/fold ([prev (exact-> start)]) ([i (in-range start (+ end delta) delta)])

36
racket/src/racket/src/numstr.c
View File

@ -495,13 +495,27 @@ START_XFORM_ARITH;
# define STRTOD(x, y, extfl) strtod(x, y) # define STRTOD(x, y, extfl) strtod(x, y)
#endif #endif
static Scheme_Object *CHECK_SINGLE(Scheme_Object *v, int s, int long_dbl) #ifdef MZ_LONG_DOUBLE
# define CHECK_SINGLE(v, s, il, l, str, len, radix) do_CHECK_SINGLE(v, s, il, l, NULL, 0, 0)
#else
# define CHECK_SINGLE(v, s, il, l, str, len, radix) do_CHECK_SINGLE(v, s, il, NULL, str, len, radix)
#endif
static Scheme_Object *do_CHECK_SINGLE(Scheme_Object *v, int s, int long_dbl,
Scheme_Object *lv, const mzchar *str, intptr_t len, int radix)
{ {
if (SCHEME_DBLP(v)) { if (SCHEME_DBLP(v)) {
#ifdef MZ_USE_SINGLE_FLOATS #ifdef MZ_USE_SINGLE_FLOATS
if (s) if (s)
return scheme_make_float((float)SCHEME_DBL_VAL(v)); return scheme_make_float((float)SCHEME_DBL_VAL(v));
#endif #endif
if (long_dbl) {
#ifdef MZ_LONG_DOUBLE
return lv;
#else
return wrap_as_long_double(scheme_utf8_encode_to_buffer(str, len, NULL, 0), radix);
#endif
}
} }
return v; return v;
@ -1456,9 +1470,9 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
/* Zero mantissa => zero inexact result */ /* Zero mantissa => zero inexact result */
if (!non_zero && result_is_float) { if (!non_zero && result_is_float) {
if (dcp && (digits[0] == '-')) if (dcp && (digits[0] == '-'))
return CHECK_SINGLE(scheme_nzerod, sgl, is_long_double); return CHECK_SINGLE(scheme_nzerod, sgl, is_long_double, scheme_nzerol, str, len, radix);
else else
return CHECK_SINGLE(scheme_zerod, sgl, is_long_double); return CHECK_SINGLE(scheme_zerod, sgl, is_long_double, scheme_zerol, str, len, radix);
} }
/* Reduce unnecessary mantissa-reading work for inexact results. */ /* Reduce unnecessary mantissa-reading work for inexact results. */
@ -1492,14 +1506,14 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
if (result_is_float) { if (result_is_float) {
if (scheme_bin_gt(exponent, scheme_make_integer(CHECK_INF_EXP_THRESHOLD(is_long_double)))) { if (scheme_bin_gt(exponent, scheme_make_integer(CHECK_INF_EXP_THRESHOLD(is_long_double)))) {
if (scheme_is_negative(mantissa)) if (scheme_is_negative(mantissa))
return CHECK_SINGLE(scheme_minus_inf_object, sgl, is_long_double); return CHECK_SINGLE(scheme_minus_inf_object, sgl, is_long_double, scheme_long_minus_inf_object, str, len, radix);
else else
return CHECK_SINGLE(scheme_inf_object, sgl, is_long_double); return CHECK_SINGLE(scheme_inf_object, sgl, is_long_double, scheme_long_inf_object, str, len, radix);
} else if (scheme_bin_lt(exponent, scheme_make_integer(-CHECK_INF_EXP_THRESHOLD(is_long_double)))) { } else if (scheme_bin_lt(exponent, scheme_make_integer(-CHECK_INF_EXP_THRESHOLD(is_long_double)))) {
if (scheme_is_negative(mantissa)) if (scheme_is_negative(mantissa))
return CHECK_SINGLE(scheme_nzerod, sgl, is_long_double); return CHECK_SINGLE(scheme_nzerod, sgl, is_long_double, scheme_nzerol, str, len, radix);
else else
return CHECK_SINGLE(scheme_zerod, sgl, is_long_double); return CHECK_SINGLE(scheme_zerod, sgl, is_long_double, scheme_zerol, str, len, radix);
} }
} }
} }
@ -1528,7 +1542,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
n = wrap_as_long_double(scheme_utf8_encode_to_buffer(str, len, NULL, 0), radix); n = wrap_as_long_double(scheme_utf8_encode_to_buffer(str, len, NULL, 0), radix);
#endif #endif
} else { } else {
n = CHECK_SINGLE(TO_DOUBLE(n), sgl, 0); n = CHECK_SINGLE(TO_DOUBLE(n), sgl, 0, NULL, NULL, 0, 0);
} }
} else { } else {
if (is_long_double) { if (is_long_double) {
@ -1538,7 +1552,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
str, len); str, len);
return scheme_false; return scheme_false;
} }
n = CHECK_SINGLE(n, sgl, 0); n = CHECK_SINGLE(n, sgl, 0, NULL, NULL, 0, 0);
} }
if (SCHEME_FLOATP(n) && str[delta] == '-') { if (SCHEME_FLOATP(n) && str[delta] == '-') {
@ -1633,7 +1647,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
} else if (is_float) } else if (is_float)
n1 = TO_DOUBLE(n1); n1 = TO_DOUBLE(n1);
return CHECK_SINGLE(n1, sgl, 0); return CHECK_SINGLE(n1, sgl, 0, NULL, NULL, 0, 0);
} }
o = scheme_read_bignum(str, delta, radix); o = scheme_read_bignum(str, delta, radix);
@ -1651,7 +1665,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
return scheme_nzerod; return scheme_nzerod;
} }
return CHECK_SINGLE(TO_DOUBLE(o), sgl, 0); return CHECK_SINGLE(TO_DOUBLE(o), sgl, 0, NULL, NULL, 0, 0);
} }
return o; return o;