[42d14c495a] Parsing long floating point strings

Author: oehhar

generic/tclStrToD.c

@@ -1822,6 +1822,8 @@ MakeHighPrecisionDouble(
     TCL_IEEE_DOUBLE_ROUNDING_DECL
 
     int machexp = 0;		/* 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.
@@ -1869,6 +1871,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) {
@@ -1896,6 +1927,9 @@ MakeHighPrecisionDouble(
      */
 
   returnValue:
+    if (significand == &bntmp) {
+	mp_clear(&bntmp);
+    }
     if (signum) {
 	retval = -retval;
     }

tests/scan.test

@@ -880,6 +880,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 {}}