Attachment "1382287.patch" to
ticket [1382287fff]
added by
dgp
2005-12-20 01:39:41.
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.133
diff -u -r1.133 tclCmdMZ.c
--- generic/tclCmdMZ.c 4 Nov 2005 22:38:38 -0000 1.133
+++ generic/tclCmdMZ.c 19 Dec 2005 18:36:25 -0000
@@ -1544,8 +1544,11 @@
failat = 0;
} else {
failat = stop - string1;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
+ if (stop < end) {
+ result = 0;
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = NULL;
+ }
}
break;
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.262
diff -u -r1.262 tclInt.h
--- generic/tclInt.h 13 Dec 2005 22:43:17 -0000 1.262
+++ generic/tclInt.h 19 Dec 2005 18:36:25 -0000
@@ -1906,6 +1906,8 @@
/* Disable floating point parsing */
#define TCL_PARSE_SCAN_PREFIXES 16
/* Use [scan] rules dealing with 0? prefixes */
+#define TCL_PARSE_NO_WHITESPACE 32
+ /* Reject leading/trailing whitespace */
/*
*----------------------------------------------------------------------
Index: generic/tclParseExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParseExpr.c,v
retrieving revision 1.31
diff -u -r1.31 tclParseExpr.c
--- generic/tclParseExpr.c 13 Dec 2005 22:43:18 -0000 1.31
+++ generic/tclParseExpr.c 19 Dec 2005 18:36:25 -0000
@@ -1616,7 +1616,7 @@
CONST char *end = infoPtr->lastChar;
CONST char* end2;
int code = TclParseNumber(NULL, NULL, NULL, src, (int)(end-src),
- &end2, 0);
+ &end2, TCL_PARSE_NO_WHITESPACE);
if (code == TCL_OK) {
length = end2-src;
Index: generic/tclScan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclScan.c,v
retrieving revision 1.22
diff -u -r1.22 tclScan.c
--- generic/tclScan.c 12 Nov 2005 04:08:05 -0000 1.22
+++ generic/tclScan.c 19 Dec 2005 18:36:25 -0000
@@ -630,7 +630,7 @@
objIndex = 0;
nconversions = 0;
while (*format != '\0') {
- int parseFlag = 0;
+ int parseFlag = TCL_PARSE_NO_WHITESPACE;
format += Tcl_UtfToUniChar(format, &ch);
flags = 0;
@@ -735,19 +735,19 @@
case 'd':
op = 'i';
- parseFlag = TCL_PARSE_DECIMAL_ONLY;
+ parseFlag |= TCL_PARSE_DECIMAL_ONLY;
break;
case 'i':
op = 'i';
- parseFlag = TCL_PARSE_SCAN_PREFIXES;
+ parseFlag |= TCL_PARSE_SCAN_PREFIXES;
break;
case 'o':
op = 'i';
- parseFlag = TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
+ parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
break;
case 'x':
op = 'i';
- parseFlag = TCL_PARSE_HEXADECIMAL_ONLY;
+ parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
break;
case 'u':
op = 'i';
@@ -955,7 +955,7 @@
width = ~0;
}
if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
- &end, TCL_PARSE_DECIMAL_ONLY)) {
+ &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
Tcl_DecrRefCount(objPtr);
if (width < 0) {
if (*end == '\0') {
Index: generic/tclStrToD.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStrToD.c,v
retrieving revision 1.17
diff -u -r1.17 tclStrToD.c
--- generic/tclStrToD.c 14 Nov 2005 17:43:51 -0000 1.17
+++ generic/tclStrToD.c 19 Dec 2005 18:36:25 -0000
@@ -177,6 +177,7 @@
* TCL_PARSE_INTEGER_ONLY.
* - TCL_PARSE_DECIMAL_ONLY: parse only in the decimal format, no
* matter whether a 0 prefix would normally force a different base.
+ * - TCL_PARSE_NO_WHITESPACE: reject any leading/trailing whitespace
*
* The arguments interp and expected are inputs that control error message
* generation. If interp is NULL, no error message will be generated.
@@ -335,6 +336,9 @@
*/
if (isspace(UCHAR(c))) {
+ if (flags & TCL_PARSE_NO_WHITESPACE) {
+ goto endgame;
+ }
break;
} else if (c == '+') {
state = SIGNUM;
@@ -893,12 +897,14 @@
/* Back up to the last accepting state in the lexer. */
p = acceptPoint;
len = acceptLen;
- if (endPtrPtr == NULL) {
+ if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
/* Accept trailing whitespace */
while (len != 0 && isspace(UCHAR(*p))) {
++p;
--len;
}
+ }
+ if (endPtrPtr == NULL) {
if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
status = TCL_ERROR;
}
Index: tests/scan.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/scan.test,v
retrieving revision 1.18
diff -u -r1.18 scan.test
--- tests/scan.test 8 Oct 2005 14:42:54 -0000 1.18
+++ tests/scan.test 19 Dec 2005 18:36:27 -0000
@@ -606,6 +606,12 @@
set arr(2) {}
list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2)
} {0 1 14}
+test scan-10.6 {miscellaneous tests} {
+ scan 5a {%i%[a]}
+} {5 a}
+test scan-10.7 {miscellaneous tests} {
+ scan {5 a} {%i%[a]}
+} {5 {}}
test scan-11.1 {alignment in results array (TCL_ALIGN)} {
scan "123 13.6" "%s %f" a b
@@ -758,4 +764,4 @@
# Local Variables:
# mode: tcl
-# End:
\ No newline at end of file
+# End:
Index: tests/string.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/string.test,v
retrieving revision 1.54
diff -u -r1.54 string.test
--- tests/string.test 9 Nov 2005 20:24:11 -0000 1.54
+++ tests/string.test 19 Dec 2005 18:36:27 -0000
@@ -661,6 +661,14 @@
}
set result
} {1 1 0 0 0 1 0 0}
+test string-6.108 {string is double, Bug 1382287} {
+ set x 2turtledoves
+ string is double $x
+ string is double $x
+} 0
+test string-6.109 {string is double, Bug 1360532} {
+ string is double 1\u00a0
+} 0
catch {rename largest_int {}}
