diff options
| -rw-r--r-- | generic/tclStrToD.c | 34 | ||||
| -rw-r--r-- | tests/scan.test | 46 |
2 files changed, 80 insertions, 0 deletions
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index ed49474..1cfadf0 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1756,6 +1756,8 @@ MakeHighPrecisionDouble( TCL_IEEE_DOUBLE_ROUNDING_DECL int machexp; /* Machine exponent of a power of 10. */ + int shift, n; + mp_int bntmp; /* * With gcc on x86, the floating point rounding mode is double-extended. @@ -1803,6 +1805,35 @@ MakeHighPrecisionDouble( * for overflow. Convert back to a double, and test for underflow. */ + /* + * TCL bug ca62367d61: the following two if-conditions handle the case, + * if the mantissa is to long to be represented. + * Very high numbers are returned, if this is not handled + */ + + + if (exponent < -511) { + mp_init_copy(&bntmp, significand); + shift = -exponent - 511; + exponent += shift; + while (shift > 0) { + n = (shift > 9) ? 9 : shift; + mp_div_d(&bntmp, (mp_digit) pow10_wide[n], &bntmp, NULL); + shift -= n; + } + significand = &bntmp; + } else if (exponent > 511) { + mp_init_copy(&bntmp, significand); + shift = exponent - 511; + exponent -= shift; + while (shift > 0) { + n = (shift > 9) ? 9 : shift; + mp_mul_d(&bntmp, (mp_digit) pow10_wide[n], &bntmp); + shift -= n; + } + significand = &bntmp; + } + retval = BignumToBiasedFrExp(significand, &machexp); retval = Pow10TimesFrExp(exponent, retval, &machexp); if (machexp > DBL_MAX_EXP*log2FLT_RADIX) { @@ -1830,6 +1861,9 @@ MakeHighPrecisionDouble( */ returnValue: + if (significand == &bntmp) { + mp_clear(&bntmp); + } if (signum) { retval = -retval; } diff --git a/tests/scan.test b/tests/scan.test index cd2ba63..606d812 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -869,6 +869,52 @@ test scan-14.2 {negative infinity} { return $d } -Inf +test scan-15.1 {scan %g overflow for small numbers and big mantissa bug 42d14c495a} { + set result [list] + # xfail: n<num> = not expected at all, x<num> expected when unfixed + foreach {exp numdig ret xfail} { + -321 190 1.111647703142804724397279783953498087821e-321 n0 + -321 191 1.111647703142804724397279783953498087821e-321 x1 + -321 300 1.111647703142804724397279783953498087821e-321 x2 + -321 1600 1.111647703142804724397279783953498087821e-321 x3 + -400 110 0 n4 + -400 111 0 n5 + -400 300 0 n6 + -221 290 1.111111111111110993454921768172890541494e-221 n7 + -221 291 1.111111111111110993454921768172890541494e-221 x8 + -221 400 1.111111111111110993454921768172890541494e-221 x9 + -221 1600 1.111111111111110993454921768172890541494e-221 x10 + -121 390 1.111111111111111182884141698869046969295e-121 n11 + -121 391 1.111111111111111182884141698869046969295e-121 x12 + -121 500 1.111111111111111182884141698869046969295e-121 x13 + -121 1600 1.111111111111111182884141698869046969295e-121 x14 + 308 202 1.111111111111111167662077577927612945036e+308 n15 + 308 203 1.111111111111111167662077577927612945036e+308 n16 + 308 300 1.111111111111111167662077577927612945036e+308 n17 + 308 1600 1.111111111111111167662077577927612945036e+308 x18 + 400 110 inf n19 + 400 111 inf n20 + 400 300 inf n21 + 221 291 1.111111111111111207481621395250718679869e+221 n22 + 221 292 1.111111111111111207481621395250718679869e+221 n23 + 221 400 1.111111111111111207481621395250718679869e+221 n24 + 221 1600 1.111111111111111207481621395250718679869e+221 x25 + 121 391 1.11111111111111112711771954138363761759e+121 n26 + 121 392 1.11111111111111112711771954138363761759e+121 n27 + 121 500 1.11111111111111112711771954138363761759e+121 n28 + 121 1600 1.11111111111111112711771954138363761759e+121 x29 + } { + set s 1.[string repeat 1 $numdig]e$exp + set d "no_scan" + scan $s %g d + set r [format %.40g $d] + if {$r ne $ret} { + lappend result $xfail=[format %.40g $d] + } + } + set result +} {} + # TODO - also need to scan NaN's catch {rename int_range {}} |