summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-01-26 23:26:13 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-01-26 23:26:13 (GMT)
commit740cd597bdeb4e570412f8fa30a97e39bdf56e99 (patch)
treeb43460f45b8ade62fc7bf65851efc1839e693600
parentebc5194e2d1e363c46561ea1303dfb409f58862f (diff)
downloadtcl-740cd597bdeb4e570412f8fa30a97e39bdf56e99.zip
tcl-740cd597bdeb4e570412f8fa30a97e39bdf56e99.tar.gz
tcl-740cd597bdeb4e570412f8fa30a97e39bdf56e99.tar.bz2
alternative TIP 395 implementation:tip_395_with_alt_name
- 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"
-rw-r--r--doc/string.n5
-rw-r--r--generic/tclCmdMZ.c49
-rw-r--r--tests/string.test102
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 {}}