From 740cd597bdeb4e570412f8fa30a97e39bdf56e99 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 26 Jan 2012 23:26:13 +0000 Subject: alternative TIP 395 implementation: - more efficient, will not generate bignum - uses "string is integer" in stead of "string is entier" - original "string is integer" renamed to "string is int" --- doc/string.n | 5 ++- generic/tclCmdMZ.c | 49 +++++++++++++++++++++++-- tests/string.test | 102 ++++++++++++++++++++++++++++++++++++----------------- 3 files changed, 120 insertions(+), 36 deletions(-) diff --git a/doc/string.n b/doc/string.n index d960b71..d1956fd 100644 --- a/doc/string.n +++ b/doc/string.n @@ -126,10 +126,13 @@ Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is false. .IP \fBgraph\fR 12 Any Unicode printing character, except space. -.IP \fBinteger\fR 12 +.IP \fBint\fR 12 Any of the valid string formats for a 32-bit integer value in Tcl, with optional surrounding whitespace. In case of under/overflow in the value, 0 is returned and the \fIvarname\fR will contain \-1. +.IP \fBinteger\fR 12 +Any of the valid string formats for an integer value in Tcl as allowed by +\fBTcl_GetBigNnum\fR, with optional surrounding whitespace. .IP \fBlist\fR 12 Any proper list structure, with optional surrounding whitespace. In case of improper list structure, 0 is returned and the \fIvarname\fR diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 1ef6fa8..38fb04a 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1437,7 +1437,7 @@ StringIsCmd( static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", "boolean", "digit", "double", "false", - "graph", "integer", "list", "lower", + "graph", "int", "integer", "list", "lower", "print", "punct", "space", "true", "upper", "wideinteger", "wordchar", "xdigit", NULL @@ -1445,7 +1445,7 @@ StringIsCmd( enum isClasses { STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL, STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_FALSE, - STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST, STR_IS_LOWER, + STR_IS_GRAPH, STR_IS_INT, STR_IS_INTEGER, STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT }; @@ -1575,6 +1575,51 @@ StringIsCmd( break; } goto failedIntParse; + case STR_IS_INTEGER: + if ((objPtr->typePtr == &tclIntType) || +#ifndef NO_WIDE_TYPE + (objPtr->typePtr == &tclWideIntType) || +#endif + (objPtr->typePtr == &tclBignumType)) { + break; + } + string1 = TclGetStringFromObj(objPtr, &length1); + if (length1 == 0) { + if (strict) { + result = 0; + } + goto str_is_done; + } + end = string1 + length1; + if (TclParseNumber(NULL, objPtr, NULL, NULL, -1, + (const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) { + if (stop == end) { + /* + * Entire string parses as an integer. + */ + + break; + } else { + /* + * Some prefix parsed as an integer, but not the whole string, + * so return failure index as the point where parsing stopped. + * Clear out the internal rep, since keeping it would leave + * *objPtr in an inconsistent state. + */ + + result = 0; + failat = stop - string1; + TclFreeIntRep(objPtr); + } + } else { + /* + * No prefix is a valid integer. Fail at beginning. + */ + + result = 0; + failat = 0; + } + break; case STR_IS_WIDE: if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) { break; diff --git a/tests/string.test b/tests/string.test index 85a7372..c8bc2d7 100644 --- a/tests/string.test +++ b/tests/string.test @@ -312,10 +312,10 @@ test string-6.4 {string is, too many args} { } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.5 {string is, class check} { list [catch {string is bogus str} msg] $msg -} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} +} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, int, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.6 {string is, ambiguous class} { list [catch {string is al str} msg] $msg -} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} +} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, int, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.7 {string is alpha, all ok} { string is alpha -strict -failindex var abc } 1 @@ -448,44 +448,44 @@ test string-6.47 {string is false, false} { catch {unset var} list [string is false -fail var offensive] $var } {0 0} -test string-6.48 {string is integer, true} { - string is integer +1234567890 +test string-6.48 {string is int, true} { + string is int +1234567890 } 1 -test string-6.49 {string is integer, true on type} { - string is integer [expr int(50.0)] +test string-6.49 {string is int, true on type} { + string is int [expr int(50.0)] } 1 -test string-6.50 {string is integer, true} { - string is integer [list -10] +test string-6.50 {string is int, true} { + string is int [list -10] } 1 -test string-6.51 {string is integer, true as hex} { - string is integer 0xabcdef +test string-6.51 {string is int, true as hex} { + string is int 0xabcdef } 1 -test string-6.52 {string is integer, true as octal} { - string is integer 012345 +test string-6.52 {string is int, true as octal} { + string is int 012345 } 1 -test string-6.53 {string is integer, true with whitespace} { - string is integer " \n1234\v" +test string-6.53 {string is int, true with whitespace} { + string is int " \n1234\v" } 1 -test string-6.54 {string is integer, false} { - list [string is integer -fail var 123abc] $var +test string-6.54 {string is int, false} { + list [string is int -fail var 123abc] $var } {0 3} -test string-6.55 {string is integer, false on overflow} { - list [string is integer -fail var +[largest_int]0] $var +test string-6.55 {string is int, false on overflow} { + list [string is int -fail var +[largest_int]0] $var } {0 -1} -test string-6.56 {string is integer, false} { - list [string is integer -fail var [expr double(1)]] $var +test string-6.56 {string is int, false} { + list [string is int -fail var [expr double(1)]] $var } {0 1} -test string-6.57 {string is integer, false} { - list [string is integer -fail var " "] $var +test string-6.57 {string is int, false} { + list [string is int -fail var " "] $var } {0 0} -test string-6.58 {string is integer, false on bad octal} { +test string-6.58 {string is int, false on bad octal} { list [string is integer -fail var 0o36963] $var } {0 4} -test string-6.58.1 {string is integer, false on bad octal} { - list [string is integer -fail var 0o36963] $var +test string-6.58.1 {string is int, false on bad octal} { + list [string is int -fail var 0o36963] $var } {0 4} -test string-6.59 {string is integer, false on bad hex} { - list [string is integer -fail var 0X345XYZ] $var +test string-6.59 {string is int, false on bad hex} { + list [string is int -fail var 0X345XYZ] $var } {0 5} test string-6.60 {string is lower, true} { string is lower abc @@ -602,21 +602,21 @@ test string-6.91 {string is double, bad doubles} { } set result } {1 1 0 0 0 1 0 0} -test string-6.92 {string is integer, 32-bit overflow} { +test string-6.92 {string is int, 32-bit overflow} { # Bug 718878 set x 0x100000000 - list [string is integer -failindex var $x] $var + list [string is int -failindex var $x] $var } {0 -1} -test string-6.93 {string is integer, 32-bit overflow} { +test string-6.93 {string is int, 32-bit overflow} { # Bug 718878 set x 0x100000000 append x "" - list [string is integer -failindex var $x] $var + list [string is int -failindex var $x] $var } {0 -1} -test string-6.94 {string is integer, 32-bit overflow} { +test string-6.94 {string is int, 32-bit overflow} { # Bug 718878 set x 0x100000000 - list [string is integer -failindex var [expr {$x}]] $var + list [string is int -failindex var [expr {$x}]] $var } {0 -1} test string-6.95 {string is wideinteger, true} { string is wideinteger +1234567890 @@ -674,6 +674,42 @@ test string-6.108 {string is double, Bug 1382287} { test string-6.109 {string is double, Bug 1360532} { string is double 1\u00a0 } 0 +test string-6.110 {string is integer, true} { + string is integer +1234567890 +} 1 +test string-6.111 {string is integer, true on type} { + string is integer [expr int(50.0)] +} 1 +test string-6.112 {string is integer, true} { + string is integer [list -10] +} 1 +test string-6.113 {string is integer, true as hex} { + string is integer 0xabcdef +} 1 +test string-6.114 {string is integer, true as octal} { + string is integer 012345 +} 1 +test string-6.115 {string is integer, true with whitespace} { + string is integer " \n1234\v" +} 1 +test string-6.116 {string is integer, false} { + list [string is integer -fail var 123abc] $var +} {0 3} +test string-6.117 {string is integer, true on integer overflow} { + string is integer +[largest_int]0 +} 1 +test string-6.118 {string is integer, false} { + list [string is integer -fail var [expr double(1)]] $var +} {0 1} +test string-6.119 {string is integer, false} { + list [string is integer -fail var " "] $var +} {0 0} +test string-6.120 {string is integer, false on bad octal} { + list [string is integer -fail var 0o36963] $var +} {0 4} +test string-6.121 {string is integer, false on bad hex} { + list [string is integer -fail var 0X345XYZ] $var +} {0 5} catch {rename largest_int {}} -- cgit v0.12