diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-01-15 10:52:26 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-01-15 10:52:26 (GMT) |
| commit | 78d6e8f34ca33491a8ae054c025f3c8925737e32 (patch) | |
| tree | 8ee5c63063059b231413d4f2f396c8c6308146a9 | |
| parent | 0cd0d2191b06b47180e585a9980ecd08a289b960 (diff) | |
| download | tcl-78d6e8f34ca33491a8ae054c025f3c8925737e32.zip tcl-78d6e8f34ca33491a8ae054c025f3c8925737e32.tar.gz tcl-78d6e8f34ca33491a8ae054c025f3c8925737e32.tar.bz2 | |
Fix [ff658e10fc]: tip 551 in 8.7a4 0b1111_1111 not working. Also fix some indenting in code
| -rw-r--r-- | generic/tclStrToD.c | 20 | ||||
| -rw-r--r-- | tests/get.test | 4 |
2 files changed, 13 insertions, 11 deletions
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index d03548c..b213bed 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -904,12 +904,14 @@ TclParseNumber( under = 0; state = BINARY; break; - } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { - /* Ignore numeric "white space" */ - under = 1; - break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } else if (c != '1') { goto endgame; + } else { + under = 0; } if (objPtr != NULL) { shift = numTrailZeros + 1; @@ -949,11 +951,11 @@ TclParseNumber( under = 0; numTrailZeros++; } else if ( ! isdigit(UCHAR(c))) { - if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { - /* Ignore numeric "white space" */ - under = 1; - break; - } + if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; + } goto endgame; } under = 0; diff --git a/tests/get.test b/tests/get.test index 3ba905b..25f8d77 100644 --- a/tests/get.test +++ b/tests/get.test @@ -110,11 +110,11 @@ test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { } } {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint { - lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " " 0_07 " " 0o_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } { + lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " 0b1111_1111 " 0_07 " " 0o_1_0 " " 0b_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } { catch {testgetint $x} x set x } -} {0 10 2 33 1423324 10 7 8 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}} +} {0 10 2 33 1423324 10 255 7 8 2 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}} # cleanup ::tcltest::cleanupTests |