summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-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
5 files changed, 34 insertions, 26 deletions
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;
}
generated by cgit v0.12 at 2024-11-19 18:45:35 (GMT)