From 52948a790cfe853df5cdbecc3c5436685b6210ba Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Sun, 22 Jan 2023 01:33:44 +0000 Subject: Bug [e3dcab1d14] fix --- generic/tclStrToD.c | 59 +++++++++++++++++++++++++++-------------------------- tests/expr.test | 37 +++++++++++++++++++++++++++++++++ 2 files changed, 67 insertions(+), 29 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 557eaa1..972b5fd 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -263,34 +263,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[28] = { + (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 */ }; /* @@ -4395,7 +4396,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 diff --git a/tests/expr.test b/tests/expr.test index 4fa6821..57c44ed 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -7277,6 +7277,43 @@ test expr-52.1 { ::tcl::unsupported::representation $a]] } {0 0 1 1} +# Bug e3dcab1d14 +proc do-one-test-expr-61 {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-61 {} { + 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-61.$p.$e "convert 2**-$e to decimal at precision $p" { + do-one-test-expr-61 $e $p $float $athreshold + } {} + } + } + rename do-one-test-expr-61 {} + rename run-test-expr-61 {} +} +run-test-expr-61 # cleanup -- cgit v0.12 From 119519c4df904cc9914302f68b70897ad33b9db3 Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Sun, 22 Jan 2023 01:37:07 +0000 Subject: Remove unneeded hard-coded array size --- generic/tclStrToD.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 972b5fd..d5578a9 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -263,7 +263,7 @@ static const int log2pow5[27] = { }; #define N_LOG2POW5 27 -static const Tcl_WideUInt wuipow5[28] = { +static const Tcl_WideUInt wuipow5[] = { (Tcl_WideUInt) 1U, /* 5**0 */ (Tcl_WideUInt) 5U, (Tcl_WideUInt) 25U, -- cgit v0.12 From 4ef7c0c4b836759619b399102ea01f01b4a61165 Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Sun, 22 Jan 2023 01:48:02 +0000 Subject: Missed one more off-by-one error, also, tests misnumbered for merge forward. --- generic/tclStrToD.c | 2 +- tests/expr.test | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index d5578a9..c55554c 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -4453,7 +4453,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 57c44ed..2434ab4 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -7278,7 +7278,7 @@ test expr-52.1 { } {0 0 1 1} # Bug e3dcab1d14 -proc do-one-test-expr-61 {e p float athreshold} { +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 @@ -7297,7 +7297,7 @@ proc do-one-test-expr-61 {e p float athreshold} { } } -proc run-test-expr-61 {} { +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} { @@ -7305,15 +7305,15 @@ proc run-test-expr-61 {} { set numer [expr {5**$e}] set xfloat x[expr {2.**-$e}] set float [string range $xfloat 1 end] - test expr-61.$p.$e "convert 2**-$e to decimal at precision $p" { - do-one-test-expr-61 $e $p $float $athreshold + 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-61 {} - rename run-test-expr-61 {} + rename do-one-test-expr-63 {} + rename run-test-expr-63 {} } -run-test-expr-61 +run-test-expr-63 # cleanup -- cgit v0.12