diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 9 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclParseExpr.c | 4 | ||||
| -rw-r--r-- | generic/tclScan.c | 14 | ||||
| -rwxr-xr-x | generic/tclStrToD.c | 29 | ||||
| -rw-r--r-- | tests/scan.test | 10 | ||||
| -rw-r--r-- | tests/string.test | 10 |
8 files changed, 66 insertions, 29 deletions
@@ -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 {}} |