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

more repairs of parsing inexact with large exponents

Browse Source 
Fix the slow-path parsing of numbers in essentially the same
way as aff167b13d.

Closes #1140
This commit is contained in:
Matthew Flatt 2015-11-21 09:15:25 -07:00
parent aff167b13d
commit 9d2dd01689
2 changed files with 57 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2404,6 +2404,29 @@
(err/rt-test (string->number "1" "1"))
(err/rt-test (string->number 1 1))
;; Test inexacts with large exponents
(test 0.0 string->number "0e401")
(test 0.0 string->number "0e6001")
(test -0.0 string->number "-0e401")
(test -0.0 string->number "-0e6001")
(test +inf.0 string->number "0.1e401")
(test +inf.0 string->number "0.1e6001")
(test -inf.0 string->number "-0.1e401")
(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 8000 #\0) "0e8000"))
(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.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 1.0e-101 string->number (string-append "0." (make-string 8000 #\0) "1e7900"))
(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 #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 #t andmap (lambda (x) (and (>= x 0) (< x 10))) (map random '(10 10 10 10)))
(test (void) random-seed 5)
(test (begin (random-seed 23) (list (random 10) (random 20) (random 30)))

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

@ -1393,7 +1393,7 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
} else {
/* Mantissa is not a fraction. */
mzchar *digits;
int extra_power = 0, dcp = 0, num_ok;
int extra_power = 0, dcp = 0, non_zero = 0, num_ok;
digits = (mzchar *)scheme_malloc_atomic((has_expt - delta + 1) * sizeof(mzchar));
@ -1402,7 +1402,11 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
digits[dcp++] = str[i++];
for (; isAdigit(str[i]) || ((radix > 10) && isbaseNdigit(radix, str[i])); i++) {
if ((radix < 10) && ((str[i] - '0') >= radix))
break;
digits[dcp++] = str[i];
if (str[i] != '0')
non_zero = 1;
}
if (str[i] == '#') {
@ -1417,8 +1421,12 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
i++;
if (num_ok)
for (; isAdigit(str[i]) || ((radix > 10) && isbaseNdigit(radix, str[i])); i++) {
if ((radix < 10) && ((str[i] - '0') >= radix))
break;
digits[dcp++] = str[i];
extra_power++;
if (str[i] != '0')
non_zero = 1;
}
for (; str[i] == '#'; i++) {
@ -1445,22 +1453,35 @@ Scheme_Object *scheme_read_number(const mzchar *str, intptr_t len,
return scheme_false;
}
/* Reduce unnecessary mantissa-reading work for inexact results.
This is also necessary to make the range check on `exponent'
correct. */
if (result_is_float && (dcp > MAX_FLOATREAD_PRECISION_DIGITS(is_long_double))) {
extra_power -= (dcp - MAX_FLOATREAD_PRECISION_DIGITS(is_long_double));
dcp = MAX_FLOATREAD_PRECISION_DIGITS(is_long_double);
/* Zero mantissa => zero inexact result */
if (!non_zero && result_is_float) {
if (dcp && (digits[0] == '-'))
return CHECK_SINGLE(scheme_nzerod, sgl, is_long_double);
else
return CHECK_SINGLE(scheme_zerod, sgl, is_long_double);
}
/* Reduce unnecessary mantissa-reading work for inexact results. */
if (result_is_float) {
Scheme_Object *max_useful;
max_useful = scheme_bin_plus(scheme_make_integer(MAX_FLOATREAD_PRECISION_DIGITS(is_long_double)),
exponent);
if (scheme_bin_lt(max_useful, scheme_make_integer(0))) {
if (dcp > 2)
dcp = 2; /* leave room for a sign and a digit */
} else if (SCHEME_INTP(max_useful)) {
if (result_is_float && (dcp > SCHEME_INT_VAL(max_useful))) {
extra_power -= (dcp - SCHEME_INT_VAL(max_useful));
dcp = SCHEME_INT_VAL(max_useful);
}
}
}
digits[dcp] = 0;
mantissa = scheme_read_bignum(digits, 0, radix);
if (SCHEME_FALSEP(mantissa)) {
/* can get here with bad radix */
if (report)
scheme_read_err(complain, stxsrc, line, col, pos, span, 0, indentation,
"read: bad number: %u",
str, len);
scheme_signal_error("internal error parsing mantissa: %s", digits);
return scheme_false;
}