Attachment "iswide.patch" to
ticket [940915ffff]
added by
kennykb
2004-04-28 02:31:45.
Index: doc/string.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/string.n,v
retrieving revision 1.18
diff -u -b -r1.18 string.n
--- doc/string.n 11 Apr 2003 20:50:47 -0000 1.18
+++ doc/string.n 27 Apr 2004 19:30:35 -0000
@@ -95,50 +95,56 @@
will not be set if the function returns 1. The following character
classes are recognized (the class name can be abbreviated):
.RS
-.IP \fBalnum\fR 10
+.IP \fBalnum\fR 12
Any Unicode alphabet or digit character.
-.IP \fBalpha\fR 10
+.IP \fBalpha\fR 12
Any Unicode alphabet character.
-.IP \fBascii\fR 10
+.IP \fBascii\fR 12
Any character with a value less than \\u0080 (those that are in the
7\-bit ascii range).
-.IP \fBboolean\fR 10
+.IP \fBboolean\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR.
-.IP \fBcontrol\fR 10
+.IP \fBcontrol\fR 12
Any Unicode control character.
-.IP \fBdigit\fR 10
+.IP \fBdigit\fR 12
Any Unicode digit character. Note that this includes characters
outside of the [0\-9] range.
-.IP \fBdouble\fR 10
+.IP \fBdouble\fR 12
Any of the valid forms for a double 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 \fBfalse\fR 10
+.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
-.IP \fBgraph\fR 10
+.IP \fBgraph\fR 12
Any Unicode printing character, except space.
-.IP \fBinteger\fR 10
-Any of the valid forms for a 32-bit integer in Tcl, with optional
+.IP \fBinteger\fR 12
+Any of the valid forms for an ordinary integer 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 \fBlower\fR 10
+.IP \fBlower\fR 12
Any Unicode lower case alphabet character.
-.IP \fBprint\fR 10
+.IP \fBprint\fR 12
Any Unicode printing character, including space.
-.IP \fBpunct\fR 10
+.IP \fBpunct\fR 12
Any Unicode punctuation character.
-.IP \fBspace\fR 10
+.IP \fBspace\fR 12
Any Unicode space character.
-.IP \fBtrue\fR 10
+.IP \fBtrue\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
true.
-.IP \fBupper\fR 10
+.IP \fBupper\fR 12
Any upper case alphabet character in the Unicode character set.
-.IP \fBwordchar\fR 10
+.VS 8.5
+.IP \fBwideinteger\fR 12
+Any of the valid forms for a wide integer in Tcl, with optional
+surrounding whitespace. In case of under/overflow in the value, 0 is
+returned and the \fIvarname\fR will contain \-1.
+.VE
+.IP \fBwordchar\fR 12
Any Unicode word character. That is any alphanumeric character, and
any Unicode connector punctuation characters (e.g. underscore).
-.IP \fBxdigit\fR 10
+.IP \fBxdigit\fR 12
Any hexadecimal digit character ([0\-9A\-Fa\-f]).
.PP
In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.101
diff -u -b -r1.101 tclCmdMZ.c
--- generic/tclCmdMZ.c 6 Apr 2004 22:25:49 -0000 1.101
+++ generic/tclCmdMZ.c 27 Apr 2004 19:30:39 -0000
@@ -1569,20 +1569,21 @@
int (*chcomp)_ANSI_ARGS_((int)) = NULL;
int i, failat = 0, result = 1, strict = 0;
Tcl_Obj *objPtr, *failVarObj = NULL;
+ Tcl_WideInt w;
static CONST char *isOptions[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "digit", "double", "false",
"graph", "integer", "lower", "print",
"punct", "space", "true", "upper",
- "wordchar", "xdigit", (char *) NULL
+ "wideinteger", "wordchar", "xdigit", (char *) NULL
};
enum isOptions {
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_LOWER, STR_IS_PRINT,
STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER,
- STR_IS_WORD, STR_IS_XDIGIT
+ STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT
};
if (objc < 4 || objc > 7) {
@@ -1803,6 +1804,47 @@
case STR_IS_UPPER:
chcomp = Tcl_UniCharIsUpper;
break;
+ case STR_IS_WIDE: {
+ char *stop;
+ long int l = 0;
+
+ if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
+ break;
+ }
+ /*
+ * Like STR_IS_DOUBLE, but we use strtoul.
+ * Since Tcl_GetIntFromObj already failed,
+ * we set result to 0.
+ */
+ result = 0;
+ errno = 0;
+ w = strtoll(string1, &stop, 0); /* INTL: Tcl source. */
+ if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) {
+ /*
+ * if (errno == ERANGE), then it was an over/underflow
+ * problem, but in this method, we only want to know
+ * yes or no, so bad flow returns 0 (false) and sets
+ * the failVarObj to the string length.
+ */
+ failat = -1;
+
+ } else if (stop == string1) {
+ /*
+ * In this case, nothing like a number was found
+ */
+ failat = 0;
+ } else {
+ /*
+ * Assume we sucked up one char per byte
+ * and then we go onto SPACE, since we are
+ * allowed trailing whitespace
+ */
+ failat = stop - string1;
+ string1 = stop;
+ chcomp = Tcl_UniCharIsSpace;
+ }
+ break;
+ }
case STR_IS_WORD:
chcomp = Tcl_UniCharIsWordChar;
break;
Index: tests/string.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/string.test,v
retrieving revision 1.39
diff -u -b -r1.39 string.test
--- tests/string.test 4 Jul 2003 10:30:27 -0000 1.39
+++ tests/string.test 27 Apr 2004 19:30:39 -0000
@@ -311,10 +311,10 @@
} {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, lower, print, punct, space, true, upper, wordchar, or xdigit}}
+} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, 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, lower, print, punct, space, true, upper, wordchar, or xdigit}}
+} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, 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
@@ -614,6 +614,51 @@
set x 0x100000000
list [string is integer -failindex var [expr {$x}]] $var
} {0 -1}
+test string-6.95 {string is wideinteger, true} {
+ string is wideinteger +1234567890
+} 1
+test string-6.96 {string is wideinteger, true on type} {
+ string is wideinteger [expr wide(50.0)]
+} 1
+test string-6.97 {string is wideinteger, true} {
+ string is wideinteger [list -10]
+} 1
+test string-6.98 {string is wideinteger, true as hex} {
+ string is wideinteger 0xabcdef
+} 1
+test string-6.99 {string is wideinteger, true as octal} {
+ string is wideinteger 0123456
+} 1
+test string-6.100 {string is wideinteger, true with whitespace} {
+ string is wideinteger " \n1234\v"
+} 1
+test string-6.101 {string is wideinteger, false} {
+ list [string is wideinteger -fail var 123abc] $var
+} {0 3}
+test string-6.102 {string is wideinteger, false on overflow} {
+ list [string is wideinteger -fail var +[largest_int]0] $var
+} {0 -1}
+test string-6.103 {string is wideinteger, false} {
+ list [string is wideinteger -fail var [expr double(1)]] $var
+} {0 1}
+test string-6.104 {string is wideinteger, false} {
+ list [string is wideinteger -fail var " "] $var
+} {0 0}
+test string-6.105 {string is wideinteger, false on bad octal} {
+ list [string is wideinteger -fail var 036963] $var
+} {0 3}
+test string-6.106 {string is wideinteger, false on bad hex} {
+ list [string is wideinteger -fail var 0X345XYZ] $var
+} {0 5}
+test string-6.105 {string is integer, bad integers} {
+ # SF bug #634856
+ set result ""
+ set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
+ foreach num $numbers {
+ lappend result [string is wideinteger -strict $num]
+ }
+ set result
+} {1 1 0 0 0 1 0 0}
catch {rename largest_int {}}
@@ -1343,3 +1388,7 @@
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
\ No newline at end of file
