summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog15
-rw-r--r--generic/tclCmdMZ.c9
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclParseExpr.c4
-rw-r--r--generic/tclScan.c14
-rwxr-xr-xgeneric/tclStrToD.c29
-rw-r--r--tests/scan.test10
-rw-r--r--tests/string.test10
8 files changed, 66 insertions, 29 deletions
diff --git a/ChangeLog b/ChangeLog
index f645c5d..c1027a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2005-12-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: Modified [string is double] to use
+ * tests/string.test: TclParseNumber() to parse trailing whitespace.
+ Ensures consistency, and makes it easier to cleanup after invalid
+ internal reps left behind by parsing [Bugs 1360432 1382287].
+
+ * generic/tclParseExpr.c: Added TCL_PARSE_NO_WHITESPACE to
+ * generic/tclScan.c: TclParseNumber() calls since [scan] and
+ * tests/scan.test: [expr] parsing don't want spaces in parsed
+ numbers.
+
+ * generic/tclInt.h: Added TCL_PARSE_NO_WHITESPACE flag to the
+ * generic/tclStrToD.c: TclParseNumber() interface.
+
2005-12-19 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
* doc/Tcl.n: Clarify what is going on in variable substitution
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1472f43..d955691 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.133 2005/11/04 22:38:38 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.134 2005/12/19 19:03:16 dgp Exp $
*/
#include "tclInt.h"
@@ -1544,8 +1544,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
failat = 0;
} else {
failat = stop - string1;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
+ if (stop < end) {
+ result = 0;
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = NULL;
+ }
}
break;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b183bca..4a0590a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.262 2005/12/13 22:43:17 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.263 2005/12/19 19:03:17 dgp Exp $
*/
#ifndef _TCLINT
@@ -1906,6 +1906,8 @@ typedef struct ProcessGlobalValue {
/* 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 */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index ae1e2b2..688447b 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclParseExpr.c,v 1.31 2005/12/13 22:43:18 kennykb Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.32 2005/12/19 19:03:17 dgp Exp $
*/
#include "tclInt.h"
@@ -1616,7 +1616,7 @@ GetLexeme(
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;
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 268353c..91909c8 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclScan.c,v 1.22 2005/11/12 04:08:05 dgp Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.23 2005/12/19 19:03:17 dgp Exp $
*/
#include "tclInt.h"
@@ -630,7 +630,7 @@ Tcl_ScanObjCmd(
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 @@ Tcl_ScanObjCmd(
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 @@ Tcl_ScanObjCmd(
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') {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 7760bee..9fe25d0 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStrToD.c,v 1.17 2005/11/14 17:43:51 dgp Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.18 2005/12/19 19:03:17 dgp Exp $
*
*----------------------------------------------------------------------
*/
@@ -162,7 +162,7 @@ static double SafeLdExp(double fraction, int exponent);
* The argument flags is an input that controls the numeric formats
* recognized by the parser. The flag bits are:
*
- * - TCL_PARSE_INTEGER_ONLY: accept only integer values; reject
+ * - TCL_PARSE_INTEGER_ONLY: accept only integer values; reject
* strings that denote floating point values (or accept only the
* leading portion of them that are integer values).
* - TCL_PARSE_SCAN_PREFIXES: ignore the prefixes 0b and 0o that are
@@ -177,6 +177,7 @@ static double SafeLdExp(double fraction, int exponent);
* 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.
@@ -204,18 +205,15 @@ static double SafeLdExp(double fraction, int exponent);
* to a terminating NUL byte).
*
* When the parser determines that a partial string matches a format
- * it is looking for, the value of endPtrPtr determines what happens.
+ * it is looking for, the value of endPtrPtr determines what happens:
*
- * If endPtrPtr is NULL, then the remainder of the string is scanned
- * and if it consists entirely of trailing whitespace, then TCL_OK is
- * returned and objPtr internals are set as above. If any non-whitespace
- * is encountered, TCL_ERROR is returned, with error message generation
- * as above.
+ * - If endPtrPtr is NULL, then TCL_ERROR is returned, with error message
+ * generation as above.
*
- * When the parser detects a partial string match and endPtrPtr is
- * non-NULL, then TCL_OK is returned and objPtr internals are set as
- * above. Also, a pointer to the first character following the parsed
- * numeric string is written to *endPtrPtr.
+ * - If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr
+ * internals are set as above. Also, a pointer to the first
+ * character following the parsed numeric string is written
+ * to *endPtrPtr.
*
* In some cases where the string being scanned is the string rep of
* objPtr, this routine can leave objPtr in an inconsistent state
@@ -335,6 +333,9 @@ TclParseNumber(
*/
if (isspace(UCHAR(c))) {
+ if (flags & TCL_PARSE_NO_WHITESPACE) {
+ goto endgame;
+ }
break;
} else if (c == '+') {
state = SIGNUM;
@@ -893,12 +894,14 @@ TclParseNumber(
/* 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;
}
diff --git a/tests/scan.test b/tests/scan.test
index 97c6d04..5bc986c 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: scan.test,v 1.18 2005/10/08 14:42:54 dgp Exp $
+# RCS: @(#) $Id: scan.test,v 1.19 2005/12/19 19:03:17 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -606,6 +606,12 @@ test scan-10.5 {miscellaneous tests} {
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 @@ return
# Local Variables:
# mode: tcl
-# End: \ No newline at end of file
+# End:
diff --git a/tests/string.test b/tests/string.test
index cc43191..a461a5e 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: string.test,v 1.54 2005/11/09 20:24:11 dgp Exp $
+# RCS: @(#) $Id: string.test,v 1.55 2005/12/19 19:03:17 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -661,6 +661,14 @@ test string-6.107 {string is integer, bad integers} {
}
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 {}}