diff options
| -rw-r--r-- | generic/tclStrToD.c | 61 | ||||
| -rw-r--r-- | tests/expr.test | 39 |
2 files changed, 70 insertions, 30 deletions
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 3b40f96..206407e 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -261,34 +261,35 @@ static const int log2pow5[27] = { }; #define N_LOG2POW5 27 -static const Tcl_WideUInt wuipow5[27] = { - (Tcl_WideUInt) 1, /* 5**0 */ - (Tcl_WideUInt) 5, - (Tcl_WideUInt) 25, - (Tcl_WideUInt) 125, - (Tcl_WideUInt) 625, - (Tcl_WideUInt) 3125, /* 5**5 */ - (Tcl_WideUInt) 3125*5, - (Tcl_WideUInt) 3125*25, - (Tcl_WideUInt) 3125*125, - (Tcl_WideUInt) 3125*625, - (Tcl_WideUInt) 3125*3125, /* 5**10 */ - (Tcl_WideUInt) 3125*3125*5, - (Tcl_WideUInt) 3125*3125*25, - (Tcl_WideUInt) 3125*3125*125, - (Tcl_WideUInt) 3125*3125*625, - (Tcl_WideUInt) 3125*3125*3125, /* 5**15 */ - (Tcl_WideUInt) 3125*3125*3125*5, - (Tcl_WideUInt) 3125*3125*3125*25, - (Tcl_WideUInt) 3125*3125*3125*125, - (Tcl_WideUInt) 3125*3125*3125*625, - (Tcl_WideUInt) 3125*3125*3125*3125, /* 5**20 */ - (Tcl_WideUInt) 3125*3125*3125*3125*5, - (Tcl_WideUInt) 3125*3125*3125*3125*25, - (Tcl_WideUInt) 3125*3125*3125*3125*125, - (Tcl_WideUInt) 3125*3125*3125*3125*625, - (Tcl_WideUInt) 3125*3125*3125*3125*3125, /* 5**25 */ - (Tcl_WideUInt) 3125*3125*3125*3125*3125*5 /* 5**26 */ +static const Tcl_WideUInt wuipow5[] = { + (Tcl_WideUInt) 1U, /* 5**0 */ + (Tcl_WideUInt) 5U, + (Tcl_WideUInt) 25U, + (Tcl_WideUInt) 125U, + (Tcl_WideUInt) 625U, + (Tcl_WideUInt) 3125U, /* 5**5 */ + (Tcl_WideUInt) 3125U*5U, + (Tcl_WideUInt) 3125U*25U, + (Tcl_WideUInt) 3125U*125U, + (Tcl_WideUInt) 3125U*625U, + (Tcl_WideUInt) 3125U*3125U, /* 5**10 */ + (Tcl_WideUInt) 3125U*3125U*5U, + (Tcl_WideUInt) 3125U*3125U*25U, + (Tcl_WideUInt) 3125U*3125U*125U, + (Tcl_WideUInt) 3125U*3125U*625U, + (Tcl_WideUInt) 3125U*3125U*3125U, /* 5**15 */ + (Tcl_WideUInt) 3125U*3125U*3125U*5U, + (Tcl_WideUInt) 3125U*3125U*3125U*25U, + (Tcl_WideUInt) 3125U*3125U*3125U*125U, + (Tcl_WideUInt) 3125U*3125U*3125U*625U, + (Tcl_WideUInt) 3125U*3125U*3125U*3125U, /* 5**20 */ + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*5U, + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*25U, + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*125U, + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*625U, + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U, /* 5**25 */ + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*5U, + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*25U /* 5**27 */ }; /* @@ -4552,7 +4553,7 @@ TclDoubleDigits( ++m2plus; } - if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] <= 64) { + if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) { /* * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact @@ -4609,7 +4610,7 @@ TclDoubleDigits( s2 -= b2; b2 = 0; } - if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] <= 64) { + if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) { /* * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact diff --git a/tests/expr.test b/tests/expr.test index 25a02e3..85860f7 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -7451,11 +7451,50 @@ test expr-62.10 {TIP 582: comments can go inside function calls} { expr {max# comment (1,2)} } 2 + +# Bug e3dcab1d14 +proc do-one-test-expr-63 {e p float athreshold} { + # e - power of 2 to test + # p - tcl_precision to test wuth + # float - floating point value 2**-$p + # athreshold - tolerable absolute error (1/2 decimal digit in + # least significant place plus 1/2 least significant bit) + set trouble {} + set ::tcl_precision $p + set xfmt x[expr $float] + set ::tcl_precision 0 + set fmt [string range $xfmt 1 end] + set aerror [expr {abs($fmt - $float)}] + if {$aerror > $athreshold} { + return "Result $fmt is more than $athreshold away from $float" + } else { + return {} + } +} + +proc run-test-expr-63 {} { + for {set e 0} {$e <= 1023} {incr e} { + set pt [expr {floor($e*log(2)/log(10))}] + for {set p 6} {$p <= 17} {incr p} { + set athreshold [expr {0.5*10.0**-($pt+$p) + 2.0**-($e+53)}] + set numer [expr {5**$e}] + set xfloat x[expr {2.**-$e}] + set float [string range $xfloat 1 end] + test expr-63.$p.$e "convert 2**-$e to decimal at precision $p" { + do-one-test-expr-63 $e $p $float $athreshold + } {} + } + } + rename do-one-test-expr-63 {} + rename run-test-expr-63 {} +} +run-test-expr-63 # cleanup unset -nocomplain a unset -nocomplain min unset -nocomplain max + ::tcltest::cleanupTests return |