-- cgit v0.12 From e38608eeb31429e3684101d8bcf151ea5fe29ed4 Mon Sep 17 00:00:00 2001 From: griffin Date: Sat, 7 Dec 2019 05:52:14 +0000 Subject: Initial implementation for TIP-551 Permit underscores in numeric literals --- generic/tclStrToD.c | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++--- tests/get.test | 6 ++++ 2 files changed, 89 insertions(+), 4 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 0e35dbf..f1bf0c6 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -529,7 +529,9 @@ TclParseNumber( * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ int explicitOctal = 0; - + int under = 0; /* Flag trailing '_' as error if true once + * number is accepted. */ + #define ALL_BITS ((Tcl_WideUInt)-1) #define MOST_BITS (ALL_BITS >> 1) @@ -637,6 +639,7 @@ TclParseNumber( acceptPoint = p; acceptLen = len; if (c == 'x' || c == 'X') { + under = 0; if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) { goto endgame; } @@ -650,6 +653,7 @@ TclParseNumber( goto zeroo; } if (c == 'b' || c == 'B') { + under = 0; if (flags & TCL_PARSE_OCTAL_ONLY) { goto endgame; } @@ -661,10 +665,12 @@ TclParseNumber( } if (c == 'o' || c == 'O') { explicitOctal = 1; + under = 0; state = ZERO_O; break; } if (c == 'd' || c == 'D') { + under = 0; state = ZERO_D; break; } @@ -688,9 +694,11 @@ TclParseNumber( zeroo: if (c == '0') { numTrailZeros++; + under = 0; state = OCTAL; break; } else if (c >= '1' && c <= '7') { + under = 0; if (objPtr != NULL) { shift = 3 * (numTrailZeros + 1); significandOverflow = AccumulateDecimalDigit( @@ -733,6 +741,10 @@ TclParseNumber( numTrailZeros = 0; state = OCTAL; break; + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } /* FALLTHROUGH */ @@ -761,6 +773,7 @@ TclParseNumber( if (c == '0') { numTrailZeros++; + under = 0; state = BAD_OCTAL; break; } else if (isdigit(UCHAR(c))) { @@ -776,12 +789,15 @@ TclParseNumber( numSigDigs = 1; } numTrailZeros = 0; + under = 0; state = BAD_OCTAL; break; } else if (c == '.') { + under = 0; state = FRACTION; break; } else if (c == 'E' || c == 'e') { + under = 0; state = EXPONENT_START; break; } @@ -804,14 +820,22 @@ TclParseNumber( zerox: if (c == '0') { numTrailZeros++; + under = 0; state = HEXADECIMAL; break; } else if (isdigit(UCHAR(c))) { + under = 0; d = (c-'0'); } else if (c >= 'A' && c <= 'F') { + under = 0; d = (c-'A'+10); } else if (c >= 'a' && c <= 'f') { + under = 0; d = (c-'a'+10); + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } else { goto endgame; } @@ -851,8 +875,13 @@ TclParseNumber( zerob: if (c == '0') { numTrailZeros++; + under = 0; state = BINARY; break; + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } else if (c != '1') { goto endgame; } @@ -886,10 +915,17 @@ TclParseNumber( case ZERO_D: if (c == '0') { + under = 0; numTrailZeros++; } else if ( ! isdigit(UCHAR(c))) { + if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; + } goto endgame; } + under = 0; state = DECIMAL; flags |= TCL_PARSE_INTEGER_ONLY; /* FALLTHROUGH */ @@ -908,6 +944,7 @@ TclParseNumber( acceptLen = len; if (c == '0') { numTrailZeros++; + under = 0; state = DECIMAL; break; } else if (isdigit(UCHAR(c))) { @@ -919,14 +956,21 @@ TclParseNumber( } numSigDigs += numTrailZeros+1; numTrailZeros = 0; + under = 0; state = DECIMAL; break; + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } else if (flags & TCL_PARSE_INTEGER_ONLY) { goto endgame; } else if (c == '.') { + under = 0; state = FRACTION; break; } else if (c == 'E' || c == 'e') { + under = 0; state = EXPONENT_START; break; } @@ -952,6 +996,7 @@ TclParseNumber( if (c == '0') { numDigitsAfterDp++; numTrailZeros++; + under = 0; state = FRACTION; break; } else if (isdigit(UCHAR(c))) { @@ -968,8 +1013,13 @@ TclParseNumber( numSigDigs = 1; } numTrailZeros = 0; + under = 0; state = FRACTION; break; + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } goto endgame; @@ -981,10 +1031,12 @@ TclParseNumber( */ if (c == '+') { + under = 0; state = EXPONENT_SIGNUM; break; } else if (c == '-') { exponentSignum = 1; + under = 0; state = EXPONENT_SIGNUM; break; } @@ -998,8 +1050,13 @@ TclParseNumber( if (isdigit(UCHAR(c))) { exponent = c - '0'; + under = 0; state = EXPONENT; break; + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } goto endgame; @@ -1018,8 +1075,13 @@ TclParseNumber( } else { exponent = LONG_MAX; } + under = 0; state = EXPONENT; break; + } else if (c == '_') { + /* Ignore numeric "white space" */ + under = 1; + break; } goto endgame; @@ -1030,12 +1092,14 @@ TclParseNumber( case sI: if (c == 'n' || c == 'N') { + under = 0; state = sIN; break; } goto endgame; case sIN: if (c == 'f' || c == 'F') { + under = 0; state = sINF; break; } @@ -1044,6 +1108,7 @@ TclParseNumber( acceptState = state; acceptPoint = p; acceptLen = len; + under = 0; if (c == 'i' || c == 'I') { state = sINFI; break; @@ -1051,24 +1116,28 @@ TclParseNumber( goto endgame; case sINFI: if (c == 'n' || c == 'N') { + under = 0; state = sINFIN; break; } goto endgame; case sINFIN: if (c == 'i' || c == 'I') { + under = 0; state = sINFINI; break; } goto endgame; case sINFINI: if (c == 't' || c == 'T') { + under = 0; state = sINFINIT; break; } goto endgame; case sINFINIT: if (c == 'y' || c == 'Y') { + under = 0; state = sINFINITY; break; } @@ -1080,12 +1149,14 @@ TclParseNumber( #ifdef IEEE_FLOATING_POINT case sN: if (c == 'a' || c == 'A') { + under = 0; state = sNA; break; } goto endgame; case sNA: if (c == 'n' || c == 'N') { + under = 0; state = sNAN; break; } @@ -1095,6 +1166,7 @@ TclParseNumber( acceptPoint = p; acceptLen = len; if (c == '(') { + under = 0; state = sNANPAREN; break; } @@ -1105,12 +1177,14 @@ TclParseNumber( */ case sNANHEX: if (c == ')') { + under = 0; state = sNANFINISH; break; } /* FALLTHROUGH */ case sNANPAREN: if (TclIsSpaceProc(c)) { + under = 0; break; } if (numSigDigs < 13) { @@ -1125,6 +1199,7 @@ TclParseNumber( } numSigDigs++; significandWide = (significandWide << 4) + d; + under = 0; state = sNANHEX; break; } @@ -1137,6 +1212,7 @@ TclParseNumber( acceptPoint = p; acceptLen = len; goto endgame; + } p++; len--; @@ -1154,11 +1230,14 @@ TclParseNumber( } } else { /* - * Back up to the last accepting state in the lexer. + * Back up to the last accepting state in the lexer. + * If the last char seen is the numeric whitespace character '_', + * backup to that. */ - p = acceptPoint; - len = acceptLen; + p = under ? acceptPoint-1 : acceptPoint; + len = under ? acceptLen-1 : acceptLen; + if (!(flags & TCL_PARSE_NO_WHITESPACE)) { /* * Accept trailing whitespace. diff --git a/tests/get.test b/tests/get.test index e35b2cc..62a074f 100644 --- a/tests/get.test +++ b/tests/get.test @@ -109,6 +109,12 @@ test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { set x } } {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_} { + catch {testgetint $x} x + set x + } +} {0 10 2 33 1423324 10 7 8 2 {expected integer but got "_33"} {expected integer but got "42_"}} # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 6d2fb7b84d5d50f685186f9866337e167a249118 Mon Sep 17 00:00:00 2001 From: griffin Date: Sat, 23 May 2020 03:32:30 +0000 Subject: Update for TIP-551: Add documentation for this feature to the expr man page. The keyword "integer value" has been added to the string and expr man page. Added TCL_PARSE_NO_UNDERSCORE flag so that the digit separator can be disabled when need when calling TclParseNumber. Disabled digit separator in the "scan" command when scanning integers and floating-point numbers. This is the one place where existing code may rely on number parsing to stop at an underscore. Disallow underscore between the leading 0 and the radix specifiers 'x', 'o', 'b', and 'd'. Added tests for disallowed underscore use and scan with underscores between digits in the source string. --- doc/expr.n | 63 ++++++++++++++++++++++++++++++++++++++--------------- doc/string.n | 2 +- generic/tclInt.h | 2 ++ generic/tclScan.c | 4 ++-- generic/tclStrToD.c | 30 +++++++++++++------------ tests/get.test | 4 ++-- tests/scan.test | 10 +++++++++ 7 files changed, 78 insertions(+), 37 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 04f0cef..1498ba1 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -17,7 +17,7 @@ expr \- Evaluate an expression .BE .SH DESCRIPTION .PP -Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates +The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates that expression, returning its value. The operators permitted in an expression include a subset of the operators permitted in C expressions. For those operators @@ -46,22 +46,6 @@ value is the form produced by the \fB%g\fR format specifier of Tcl's An expression consists of a combination of operands, operators, parentheses and commas, possibly with whitespace between any of these elements, which is ignored. -An integer operand may be specified in decimal (the normal case, the optional -first two characters are \fB0d\fR), binary -(the first two characters are \fB0b\fR), octal -(the first two characters are \fB0o\fR), or hexadecimal -(the first two characters are \fB0x\fR) form. For -compatibility with older Tcl releases, an operand that begins with \fB0\fR is -interpreted as an octal integer even if the second character is not \fBo\fR. -A floating-point number may be specified in any of several -common decimal formats, and may use the decimal point \fB.\fR, -\fBe\fR or \fBE\fR for scientific notation, and -the sign characters \fB+\fR and \fB\-\fR. The -following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16. -The strings \fBInf\fR -and \fBNaN\fR, in any combination of case, are also recognized as floating point -values. An operand that doesn't have a numeric interpretation must be quoted -with either braces or with double quotes. .PP An operand may be specified in any of the following ways: .IP [1] @@ -103,6 +87,49 @@ produces the value on the right side. \fBexpr\fR 4*[llength "6 2"] \fI8\fR \fBexpr\fR {{word one} < "word $a"} \fI0\fR .CE +.PP +\fBInteger value\fR +.PP +An integer operand may be specified in decimal (the normal case, the optional +first two characters are \fB0d\fR), binary +(the first two characters are \fB0b\fR), octal +(the first two characters are \fB0o\fR), or hexadecimal +(the first two characters are \fB0x\fR) form. For +compatibility with older Tcl releases, an operand that begins with \fB0\fR is +interpreted as an octal integer even if the second character is not \fBo\fR. +.PP +\fBFloating-point value\fR +.PP +A floating-point number may be specified in any of several +common decimal formats, and may use the decimal point \fB.\fR, +\fBe\fR or \fBE\fR for scientific notation, and +the sign characters \fB+\fR and \fB\-\fR. The +following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16. +The strings \fBInf\fR +and \fBNaN\fR, in any combination of case, are also recognized as floating point +values. An operand that doesn't have a numeric interpretation must be quoted +with either braces or with double quotes. +.PP +\fBBoolean value\fR +.PP +A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR, +or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR. +.PP +\fBDigit Separator\fR +.PP +Digits in any numeric value may be separated with one or more underscore +characters, "\fB_\fR", to improve readability. These separators may only +appear between digits. The separator may not appear at the start of a +numeric value, between the leading 0 and radix specifier, or at the +end of a numeric value. Here are some examples: +.PP +.CS +.ta 9c +\fBexpr\fR 100_000_000 \fI100000000\fR +\fBexpr\fR 0xffff_ffff \fI4294967295\fR +\fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR +.CE +.PP .SS OPERATORS .PP For operators having both a numeric mode and a string mode, the numeric mode is @@ -474,7 +501,7 @@ set randNum [\fBexpr\fR { int(100 * rand()) }] array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n), string(n), Tcl(n), while(n) .SH KEYWORDS -arithmetic, boolean, compare, expression, fuzzy comparison +arithmetic, boolean, compare, expression, fuzzy comparison, integer value .SH COPYRIGHT .nf Copyright \(co 1993 The Regents of the University of California. diff --git a/doc/string.n b/doc/string.n index 44d621d..7cd53ca 100644 --- a/doc/string.n +++ b/doc/string.n @@ -505,7 +505,7 @@ if {$length == 0} { .SH "SEE ALSO" expr(n), list(n) .SH KEYWORDS -case conversion, compare, index, match, pattern, string, word, equal, +case conversion, compare, index, integer value, match, pattern, string, word, equal, ctype, character, reverse .\" Local Variables: .\" mode: nroff diff --git a/generic/tclInt.h b/generic/tclInt.h index 681cb61..e96a0f4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2703,6 +2703,8 @@ typedef struct ProcessGlobalValue { /* Reject leading/trailing whitespace. */ #define TCL_PARSE_BINARY_ONLY 64 /* Parse binary even without prefix. */ +#define TCL_PARSE_NO_UNDERSCORE 128 + /* Reject underscore digit separator */ /* *---------------------------------------------------------------------- diff --git a/generic/tclScan.c b/generic/tclScan.c index 5916137..5c01c33 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -902,7 +902,7 @@ Tcl_ScanObjCmd( width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, - &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) { + &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { @@ -1006,7 +1006,7 @@ Tcl_ScanObjCmd( width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, - &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) { + &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index f1bf0c6..41dbd0d 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -639,8 +639,7 @@ TclParseNumber( acceptPoint = p; acceptLen = len; if (c == 'x' || c == 'X') { - under = 0; - if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) { + if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY) || under) { goto endgame; } state = ZERO_X; @@ -653,8 +652,7 @@ TclParseNumber( goto zeroo; } if (c == 'b' || c == 'B') { - under = 0; - if (flags & TCL_PARSE_OCTAL_ONLY) { + if ((flags & TCL_PARSE_OCTAL_ONLY) || under) { goto endgame; } state = ZERO_B; @@ -664,13 +662,17 @@ TclParseNumber( goto zerob; } if (c == 'o' || c == 'O') { + if (under) { + goto endgame; + } explicitOctal = 1; - under = 0; state = ZERO_O; break; } if (c == 'd' || c == 'D') { - under = 0; + if (under) { + goto endgame; + } state = ZERO_D; break; } @@ -741,7 +743,7 @@ TclParseNumber( numTrailZeros = 0; state = OCTAL; break; - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -832,7 +834,7 @@ TclParseNumber( } else if (c >= 'a' && c <= 'f') { under = 0; d = (c-'a'+10); - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -878,7 +880,7 @@ TclParseNumber( under = 0; state = BINARY; break; - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -918,7 +920,7 @@ TclParseNumber( under = 0; numTrailZeros++; } else if ( ! isdigit(UCHAR(c))) { - if (c == '_') { + if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -959,7 +961,7 @@ TclParseNumber( under = 0; state = DECIMAL; break; - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -1016,7 +1018,7 @@ TclParseNumber( under = 0; state = FRACTION; break; - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -1053,7 +1055,7 @@ TclParseNumber( under = 0; state = EXPONENT; break; - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; @@ -1078,7 +1080,7 @@ TclParseNumber( under = 0; state = EXPONENT; break; - } else if (c == '_') { + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { /* Ignore numeric "white space" */ under = 1; break; diff --git a/tests/get.test b/tests/get.test index 62a074f..7ab189c 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_} { + 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 } { catch {testgetint $x} x set x } -} {0 10 2 33 1423324 10 7 8 2 {expected integer but got "_33"} {expected integer but got "42_"}} +} {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"}} # cleanup ::tcltest::cleanupTests diff --git a/tests/scan.test b/tests/scan.test index b488f68..eaeaa49 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -555,6 +555,11 @@ test scan-5.19 {bigint scanning invalid} -setup { list [scan "207698809136909011942886895" \ %llu a] $a } -result {1 207698809136909011942886895} +test scan-5.20 {ignore digit separators} -setup { + set a {}; set b {}; set c {}; +} -body { + list [scan "10_23_45" %d_%d_%d a b c] $a $b $c +} -result {3 10 23 45} test scan-6.1 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} @@ -600,6 +605,11 @@ test scan-6.8 {floating-point scanning} -setup { } -body { list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d } -result {2 4.6 5.2 {} {}} +test scan-6.8 {disallow diget separator in floating-point} -setup { + set a {}; set b {}; set c {}; +} -body { + list [scan "3.14_2.35_98.6" %f_%f_%f a b c ] $a $b $c +} -result {3 3.14 2.35 98.6} test scan-7.1 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} -- cgit v0.12