summaryrefslogtreecommitdiffstats
path: root/generic/tclParse.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2002-08-05 03:24:39 (GMT)
committerdgp <dgp@users.sourceforge.net>2002-08-05 03:24:39 (GMT)
commitb3debf8fa6252ac20fea32f74530a37a1b013ba3 (patch)
tree55bc26f8f6a88258d08fd90ff9a8943937349574 /generic/tclParse.c
parenta96927be11c81e5e49d42cb7d0574729840d8f17 (diff)
downloadtcl-b3debf8fa6252ac20fea32f74530a37a1b013ba3.zip
tcl-b3debf8fa6252ac20fea32f74530a37a1b013ba3.tar.gz
tcl-b3debf8fa6252ac20fea32f74530a37a1b013ba3.tar.bz2
* doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify
* doc/Concat.3: all remaining public interfaces of Tcl. * doc/CrtCommand.3: Notably, the parser no longer writes on * doc/CrtSlave.3: the string it is parsing, so it is no * doc/CrtTrace.3: longer necessary for Tcl_Eval() to be * doc/Eval.3: given a writable string. Also, the * doc/ExprLong.3: refactoring of the Tcl_*Var* routines * doc/LinkVar.3: by Miguel Sofer is included, so that the * doc/ParseCmd.3: "part1" argument for them no longer needs * doc/SetVar.3: to be writable either. * doc/TraceVar.3: * doc/UpVar.3: Compatibility support has been enhanced so * generic/tcl.decls that a #define of USE_NON_CONST will remove * generic/tcl.h all possible source incompatibilities with * generic/tclBasic.c the 8.3 version of the header file(s). * generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does * generic/tclCompCmds.c what USE_NON_CONST used to do -- disable * generic/tclCompExpr.c only those new CONST's that introduce * generic/tclCompile.c irreconcilable incompatibilities. * generic/tclCompile.h * generic/tclDecls.h Several bugs are also fixed by this patch. * generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429] * generic/tclEvent.c * generic/tclInt.decls * generic/tclInt.h * generic/tclIntDecls.h * generic/tclInterp.c * generic/tclLink.c * generic/tclObj.c * generic/tclParse.c * generic/tclParseExpr.c * generic/tclProc.c * generic/tclTest.c * generic/tclUtf.c * generic/tclUtil.c * generic/tclVar.c * mac/tclMacTest.c * tests/expr-old.test * tests/parseExpr.test * unix/tclUnixTest.c * unix/tclXtTest.c * win/tclWinTest.c
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r--generic/tclParse.c984
1 files changed, 632 insertions, 352 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c
index b22df23..230edee 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -8,11 +8,12 @@
*
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Ajuba Solutions.
+ * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclParse.c,v 1.21 2002/07/19 10:12:28 dkf Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.22 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -31,32 +32,32 @@
* information about its character argument. The following return
* values are defined.
*
- * TYPE_NORMAL - All characters that don't have special significance
- * to the Tcl parser.
- * TYPE_SPACE - The character is a whitespace character other
- * than newline.
- * TYPE_COMMAND_END - Character is newline or semicolon.
- * TYPE_SUBS - Character begins a substitution or has other
- * special meaning in ParseTokens: backslash, dollar
- * sign, open bracket, or null.
- * TYPE_QUOTE - Character is a double quote.
- * TYPE_CLOSE_PAREN - Character is a right parenthesis.
- * TYPE_CLOSE_BRACK - Character is a right square bracket.
- * TYPE_BRACE - Character is a curly brace (either left or right).
+ * TYPE_NORMAL - All characters that don't have special significance
+ * to the Tcl parser.
+ * TYPE_SPACE - The character is a whitespace character other
+ * than newline.
+ * TYPE_COMMAND_END - Character is newline or semicolon.
+ * TYPE_SUBS - Character begins a substitution or has other
+ * special meaning in ParseTokens: backslash, dollar
+ * sign, or open bracket.
+ * TYPE_QUOTE - Character is a double quote.
+ * TYPE_CLOSE_PAREN - Character is a right parenthesis.
+ * TYPE_CLOSE_BRACK - Character is a right square bracket.
+ * TYPE_BRACE - Character is a curly brace (either left or right).
*/
-#define TYPE_NORMAL 0
-#define TYPE_SPACE 0x1
-#define TYPE_COMMAND_END 0x2
-#define TYPE_SUBS 0x4
-#define TYPE_QUOTE 0x8
-#define TYPE_CLOSE_PAREN 0x10
-#define TYPE_CLOSE_BRACK 0x20
-#define TYPE_BRACE 0x40
+#define TYPE_NORMAL 0
+#define TYPE_SPACE 0x1
+#define TYPE_COMMAND_END 0x2
+#define TYPE_SUBS 0x4
+#define TYPE_QUOTE 0x8
+#define TYPE_CLOSE_PAREN 0x10
+#define TYPE_CLOSE_BRACK 0x20
+#define TYPE_BRACE 0x40
-#define CHAR_TYPE(c) (typeTable+128)[(int)(c)]
+#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-static CONST char typeTable[] = {
+static CONST char charTypeTable[] = {
/*
* Negative character values, from -128 to -1:
*/
@@ -173,11 +174,13 @@ static CONST char typeTable[] = {
* Prototypes for local procedures defined in this file:
*/
-static int CommandComplete _ANSI_ARGS_((char *script,
- int length));
-static int ParseTokens _ANSI_ARGS_((char *src, int mask,
+static int CommandComplete _ANSI_ARGS_((CONST char *script,
+ int numBytes));
+static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,
Tcl_Parse *parsePtr));
-
+static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
+ int mask, Tcl_Parse *parsePtr));
+
/*
*----------------------------------------------------------------------
*
@@ -209,14 +212,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* First character of string containing
- * one or more Tcl commands. The string
- * must be in writable memory and must
- * have one additional byte of space at
- * string[length] where we can
- * temporarily store a 0 sentinel
- * character. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ CONST char *string; /* First character of string containing
+ * one or more Tcl commands. */
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the script consists of all bytes up to
* the first null character. */
int nested; /* Non-zero means this is a nested command:
@@ -229,21 +227,25 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* information in the structure is
* ignored. */
{
- register char *src; /* Points to current character
+ register CONST char *src; /* Points to current character
* in the command. */
- int type; /* Result returned by CHAR_TYPE(*src). */
+ char type; /* Result returned by CHAR_TYPE(*src). */
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
int wordIndex; /* Index of word token for current word. */
- char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */
int terminators; /* CHAR_TYPE bits that indicate the end
* of a command. */
- char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
+ CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
* point to char after terminating one. */
- int length, savedChar;
-
-
+ int scanned;
+
+ if ((string == NULL) && (numBytes>0)) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
if (numBytes < 0) {
- numBytes = (string? strlen(string) : 0);
+ numBytes = strlen(string);
}
parsePtr->commentStart = NULL;
parsePtr->commentSize = 0;
@@ -266,66 +268,15 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
}
/*
- * Temporarily overwrite the character just after the end of the
- * string with a 0 byte. This acts as a sentinel and reduces the
- * number of places where we have to check for the end of the
- * input string. The original value of the byte is restored at
- * the end of the parse.
- */
-
- savedChar = string[numBytes];
- if (savedChar != 0) {
- string[numBytes] = 0;
- }
-
- /*
* Parse any leading space and comments before the first word of the
* command.
*/
- src = string;
- while (1) {
- while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
- src++;
- }
- if ((*src == '\\') && (src[1] == '\n')) {
- /*
- * Skip backslash-newline sequence: it should be treated
- * just like white space.
- */
-
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- src += 2;
- continue;
- }
- if (*src != '#') {
- break;
- }
- if (parsePtr->commentStart == NULL) {
- parsePtr->commentStart = src;
- }
- while (1) {
- if (src == parsePtr->end) {
- if (nested) {
- parsePtr->incomplete = nested;
- }
- parsePtr->commentSize = src - parsePtr->commentStart;
- break;
- } else if (*src == '\\') {
- if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- } else if (*src == '\n') {
- src++;
- parsePtr->commentSize = src - parsePtr->commentStart;
- break;
- } else {
- src++;
- }
+ scanned = ParseComment(string, numBytes, parsePtr);
+ src = (string + scanned); numBytes -= scanned;
+ if (numBytes == 0) {
+ if (nested) {
+ parsePtr->incomplete = nested;
}
}
@@ -352,19 +303,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* sequence: it should be treated just like white space.
*/
- while (1) {
- type = CHAR_TYPE(*src);
- if (type == TYPE_SPACE) {
- src++;
- continue;
- } else if ((*src == '\\') && (src[1] == '\n')) {
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- continue;
- }
+ scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ src += scanned; numBytes -= scanned;
+ if (numBytes == 0) {
break;
}
if ((type & terminators) != 0) {
@@ -372,9 +313,6 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
src++;
break;
}
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->start = src;
parsePtr->numTokens++;
parsePtr->numWords++;
@@ -386,28 +324,28 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
*/
if (*src == '"') {
- if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseQuotedString(interp, src, numBytes,
+ parsePtr, 1, &termPtr) != TCL_OK) {
goto error;
}
- src = termPtr;
+ src = termPtr; numBytes = parsePtr->end - src;
} else if (*src == '{') {
- if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseBraces(interp, src, numBytes,
+ parsePtr, 1, &termPtr) != TCL_OK) {
goto error;
}
- src = termPtr;
+ src = termPtr; numBytes = parsePtr->end - src;
} else {
/*
* This is an unquoted word. Call ParseTokens and let it do
* all of the work.
*/
- if (ParseTokens(src, TYPE_SPACE|terminators,
+ if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
parsePtr) != TCL_OK) {
goto error;
}
- src = parsePtr->term;
+ src = parsePtr->term; numBytes = parsePtr->end - src;
}
/*
@@ -431,32 +369,18 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* command.
*/
- type = CHAR_TYPE(*src);
- if (type == TYPE_SPACE) {
- src++;
+ scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ if (scanned) {
+ src += scanned; numBytes -= scanned;
continue;
- } else {
- /*
- * Backslash-newline (and any following white space) must be
- * treated as if it were a space character.
- */
-
- if ((*src == '\\') && (src[1] == '\n')) {
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- continue;
- }
}
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
+ if (numBytes == 0) {
break;
}
- if (src == parsePtr->end) {
+ if ((type & terminators) != 0) {
+ parsePtr->term = src;
+ src++;
break;
}
if (src[-1] == '"') {
@@ -476,17 +400,10 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
goto error;
}
-
parsePtr->commandSize = src - parsePtr->commandStart;
- if (savedChar != 0) {
- string[numBytes] = (char) savedChar;
- }
return TCL_OK;
error:
- if (savedChar != 0) {
- string[numBytes] = (char) savedChar;
- }
Tcl_FreeParse(parsePtr);
if (parsePtr->commandStart == NULL) {
parsePtr->commandStart = string;
@@ -494,17 +411,361 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
return TCL_ERROR;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseWhiteSpace --
+ *
+ * Scans up to numBytes bytes starting at src, consuming white
+ * space as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Returns the number of bytes recognized as white space. Records
+ * at parsePtr, information about the parse. Records at typePtr
+ * the character type of the non-whitespace character that terminated
+ * the scan.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
+ CONST char *src; /* First character to parse. */
+ register int numBytes; /* Max number of bytes to scan. */
+ Tcl_Parse *parsePtr; /* Information about parse in progress.
+ * Updated if parsing indicates
+ * an incomplete command. */
+ char *typePtr; /* Points to location to store character
+ * type of character that ends run
+ * of whitespace */
+{
+ register char type = TYPE_NORMAL;
+ register CONST char *p = src;
+
+ while (1) {
+ while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
+ numBytes--; p++;
+ }
+ if (numBytes && (type & TYPE_SUBS)) {
+ if (*p != '\\') {
+ break;
+ }
+ if (--numBytes == 0) {
+ break;
+ }
+ if (p[1] != '\n') {
+ break;
+ }
+ p+=2;
+ if (--numBytes == 0) {
+ parsePtr->incomplete = 1;
+ break;
+ }
+ continue;
+ }
+ break;
+ }
+ *typePtr = type;
+ return (p - src);
+}
/*
*----------------------------------------------------------------------
*
+ * TclParseHex --
+ *
+ * Scans a hexadecimal number as a Tcl_UniChar value.
+ * (e.g., for parsing \x and \u escape sequences).
+ * At most numBytes bytes are scanned.
+ *
+ * Results:
+ * The numeric value is stored in *resultPtr.
+ * Returns the number of bytes consumed.
+ *
+ * Notes:
+ * Relies on the following properties of the ASCII
+ * character set, with which UTF-8 is compatible:
+ *
+ * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z'
+ * occupy consecutive code points, and '0' < 'A' < 'a'.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseHex(src, numBytes, resultPtr)
+ CONST char *src; /* First character to parse. */
+ int numBytes; /* Max number of byes to scan */
+ Tcl_UniChar *resultPtr; /* Points to storage provided by
+ * caller where the Tcl_UniChar
+ * resulting from the conversion is
+ * to be written. */
+{
+ Tcl_UniChar result = 0;
+ register CONST char *p = src;
+
+ while (numBytes--) {
+ unsigned char digit = UCHAR(*p);
+
+ if (!isxdigit(digit))
+ break;
+
+ ++p;
+ result <<= 4;
+
+ if (digit >= 'a') {
+ result |= (10 + digit - 'a');
+ } else if (digit >= 'A') {
+ result |= (10 + digit - 'A');
+ } else {
+ result |= (digit - '0');
+ }
+ }
+
+ *resultPtr = result;
+ return (p - src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseBackslash --
+ *
+ * Scans up to numBytes bytes starting at src, consuming a
+ * backslash sequence as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Records at readPtr the number of bytes making up the backslash
+ * sequence. Records at dst the UTF-8 encoded equivalent of
+ * that backslash sequence. Returns the number of bytes written
+ * to dst, at most TCL_UTF_MAX. Either readPtr or dst may be
+ * NULL, if the results are not needed, but the return value is
+ * the same either way.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseBackslash(src, numBytes, readPtr, dst)
+ CONST char * src; /* Points to the backslash character of a
+ * a backslash sequence */
+ int numBytes; /* Max number of bytes to scan */
+ int *readPtr; /* NULL, or points to storage where the
+ * number of bytes scanned should be written. */
+ char *dst; /* NULL, or points to buffer where the UTF-8
+ * encoding of the backslash sequence is to be
+ * written. At most TCL_UTF_MAX bytes will be
+ * written there. */
+{
+ register CONST char *p = src+1;
+ Tcl_UniChar result;
+ int count;
+ char buf[TCL_UTF_MAX];
+
+ if (numBytes == 0) {
+ if (readPtr != NULL) {
+ *readPtr = 0;
+ }
+ return 0;
+ }
+
+ if (dst == NULL) {
+ dst = buf;
+ }
+
+ if (numBytes == 1) {
+ /* Can only scan the backslash. Return it. */
+ result = '\\';
+ count = 1;
+ goto done;
+ }
+
+ count = 2;
+ switch (*p) {
+ /*
+ * Note: in the conversions below, use absolute values (e.g.,
+ * 0xa) rather than symbolic values (e.g. \n) that get converted
+ * by the compiler. It's possible that compilers on some
+ * platforms will do the symbolic conversions differently, which
+ * could result in non-portable Tcl scripts.
+ */
+
+ case 'a':
+ result = 0x7;
+ break;
+ case 'b':
+ result = 0x8;
+ break;
+ case 'f':
+ result = 0xc;
+ break;
+ case 'n':
+ result = 0xa;
+ break;
+ case 'r':
+ result = 0xd;
+ break;
+ case 't':
+ result = 0x9;
+ break;
+ case 'v':
+ result = 0xb;
+ break;
+ case 'x':
+ count += TclParseHex(p+1, numBytes-1, &result);
+ if (count == 2) {
+ /* No hexadigits -> This is just "x". */
+ result = 'x';
+ } else {
+ /* Keep only the last byte (2 hex digits) */
+ result = (unsigned char) result;
+ }
+ break;
+ case 'u':
+ count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
+ if (count == 2) {
+ /* No hexadigits -> This is just "u". */
+ result = 'u';
+ }
+ break;
+ case '\n':
+ count--;
+ do {
+ p++; count++;
+ } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
+ result = ' ';
+ break;
+ case 0:
+ result = '\\';
+ count = 1;
+ break;
+ default:
+ /*
+ * Check for an octal number \oo?o?
+ */
+ if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
+ result = (unsigned char)(*p - '0');
+ p++;
+ if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
+ || (UCHAR(*p) >= '8')) {
+ break;
+ }
+ count = 3;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ p++;
+ if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
+ || (UCHAR(*p) >= '8')) {
+ break;
+ }
+ count = 4;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ break;
+ }
+ /*
+ * We have to convert here in case the user has put a
+ * backslash in front of a multi-byte utf-8 character.
+ * While this means nothing special, we shouldn't break up
+ * a correct utf-8 character. [Bug #217987] test subst-3.2
+ */
+ if (Tcl_UtfCharComplete(p, numBytes - 1)) {
+ count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, p, (size_t) (numBytes - 1));
+ utfBytes[numBytes - 1] = '\0';
+ count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
+ }
+ break;
+ }
+
+ done:
+ if (readPtr != NULL) {
+ *readPtr = count;
+ }
+ return Tcl_UniCharToUtf((int) result, dst);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseComment --
+ *
+ * Scans up to numBytes bytes starting at src, consuming a
+ * Tcl comment as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Records in parsePtr information about the parse. Returns the
+ * number of bytes consumed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseComment(src, numBytes, parsePtr)
+ CONST char *src; /* First character to parse. */
+ register int numBytes; /* Max number of bytes to scan. */
+ Tcl_Parse *parsePtr; /* Information about parse in progress.
+ * Updated if parsing indicates
+ * an incomplete command. */
+{
+ register CONST char *p = src;
+ while (numBytes) {
+ char type;
+ int scanned;
+ do {
+ scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ p += scanned; numBytes -= scanned;
+ } while (numBytes && (*p == '\n') && (p++,numBytes--));
+ if ((numBytes == 0) || (*p != '#')) {
+ break;
+ }
+ if (parsePtr->commentStart == NULL) {
+ parsePtr->commentStart = p;
+ }
+ while (numBytes) {
+ if (*p == '\\') {
+ scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ if (scanned) {
+ p += scanned; numBytes -= scanned;
+ } else {
+ /*
+ * General backslash substitution in comments isn't
+ * part of the formal spec, but test parse-15.47
+ * and history indicate that it has been the de facto
+ * rule. Don't change it now.
+ */
+ TclParseBackslash(p, numBytes, &scanned, NULL);
+ p += scanned; numBytes -= scanned;
+ }
+ } else {
+ p++; numBytes--;
+ if (p[-1] == '\n') {
+ break;
+ }
+ }
+ }
+ parsePtr->commentSize = p - parsePtr->commentStart;
+ }
+ return (p - src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseTokens --
*
* This procedure forms the heart of the Tcl parser. It parses one
* or more tokens from a string, up to a termination point
* specified by the caller. This procedure is used to parse
* unquoted command words (those not in quotes or braces), words in
- * quotes, and array indices for variables.
+ * quotes, and array indices for variables. No more than numBytes
+ * bytes will be scanned.
*
* Results:
* Tokens are added to parsePtr and parsePtr->term is filled in
@@ -522,8 +783,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
*/
static int
-ParseTokens(src, mask, parsePtr)
- register char *src; /* First character to parse. */
+ParseTokens(src, numBytes, mask, parsePtr)
+ register CONST char *src; /* First character to parse. */
+ register int numBytes; /* Max number of bytes to scan. */
int mask; /* Specifies when to stop parsing. The
* parse stops at the first unquoted
* character whose CHAR_TYPE contains
@@ -532,8 +794,8 @@ ParseTokens(src, mask, parsePtr)
* Updated with additional tokens and
* termination information. */
{
- int type, originalTokens, varToken;
- char utfBytes[TCL_UTF_MAX];
+ char type;
+ int originalTokens, varToken;
Tcl_Token *tokenPtr;
Tcl_Parse nested;
@@ -545,7 +807,7 @@ ParseTokens(src, mask, parsePtr)
*/
originalTokens = parsePtr->numTokens;
- while (1) {
+ while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
TclExpandTokenArray(parsePtr);
}
@@ -553,22 +815,15 @@ ParseTokens(src, mask, parsePtr)
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- type = CHAR_TYPE(*src);
- if (type & mask) {
- break;
- }
-
if ((type & TYPE_SUBS) == 0) {
/*
* This is a simple range of characters. Scan to find the end
* of the range.
*/
- while (1) {
- src++;
- if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) {
- break;
- }
+ while ((++src, --numBytes)
+ && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
+ /* empty loop */
}
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = src - tokenPtr->start;
@@ -580,11 +835,12 @@ ParseTokens(src, mask, parsePtr)
*/
varToken = parsePtr->numTokens;
- if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
+ if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
parsePtr, 1) != TCL_OK) {
return TCL_ERROR;
}
src += parsePtr->tokenPtr[varToken].size;
+ numBytes -= parsePtr->tokenPtr[varToken].size;
} else if (*src == '[') {
/*
* Command substitution. Call Tcl_ParseCommand recursively
@@ -592,23 +848,24 @@ ParseTokens(src, mask, parsePtr)
* throw away the parse information.
*/
- src++;
+ src++; numBytes--;
while (1) {
if (Tcl_ParseCommand(parsePtr->interp, src,
- parsePtr->end - src, 1, &nested) != TCL_OK) {
+ numBytes, 1, &nested) != TCL_OK) {
parsePtr->errorType = nested.errorType;
parsePtr->term = nested.term;
parsePtr->incomplete = nested.incomplete;
return TCL_ERROR;
}
src = nested.commandStart + nested.commandSize;
+ numBytes = parsePtr->end - src;
if (nested.tokenPtr != nested.staticTokens) {
ckfree((char *) nested.tokenPtr);
}
if ((*nested.term == ']') && !nested.incomplete) {
break;
}
- if (src == parsePtr->end) {
+ if (numBytes == 0) {
if (parsePtr->interp != NULL) {
Tcl_SetResult(parsePtr->interp,
"missing close-bracket", TCL_STATIC);
@@ -626,9 +883,18 @@ ParseTokens(src, mask, parsePtr)
/*
* Backslash substitution.
*/
+ TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
+
+ if (tokenPtr->size == 1) {
+ /* Just a backslash, due to end of string */
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ parsePtr->numTokens++;
+ src++; numBytes--;
+ continue;
+ }
if (src[1] == '\n') {
- if ((src + 2) == parsePtr->end) {
+ if (numBytes == 2) {
parsePtr->incomplete = 1;
}
@@ -639,28 +905,22 @@ ParseTokens(src, mask, parsePtr)
*/
if (mask & TYPE_SPACE) {
+ if (parsePtr->numTokens == originalTokens) {
+ goto finishToken;
+ }
break;
}
}
+
tokenPtr->type = TCL_TOKEN_BS;
- Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
parsePtr->numTokens++;
src += tokenPtr->size;
+ numBytes -= tokenPtr->size;
} else if (*src == 0) {
- /*
- * We encountered a null character. If it is the null
- * character at the end of the string, then return.
- * Otherwise generate a text token for the single
- * character.
- */
-
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 1;
parsePtr->numTokens++;
- src++;
+ src++; numBytes--;
} else {
panic("ParseTokens encountered unknown character");
}
@@ -671,7 +931,14 @@ ParseTokens(src, mask, parsePtr)
* for the empty range, so that there is always at least one
* token added.
*/
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ finishToken:
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 0;
parsePtr->numTokens++;
@@ -679,7 +946,7 @@ ParseTokens(src, mask, parsePtr)
parsePtr->term = src;
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -708,7 +975,7 @@ Tcl_FreeParse(parsePtr)
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -746,14 +1013,15 @@ TclExpandTokenArray(parsePtr)
parsePtr->tokenPtr = newPtr;
parsePtr->tokensAvailable = newCount;
}
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_ParseVarName --
*
* Given a string starting with a $ sign, parse off a variable
- * name and return information about the parse.
+ * name and return information about the parse. No more than
+ * numBytes bytes will be scanned.
*
* Results:
* The return value is TCL_OK if the command was parsed
@@ -780,9 +1048,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing variable name. First
+ CONST char *string; /* String containing variable name. First
* character must be "$". */
- int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr; /* Structure to fill in with information
@@ -793,16 +1061,17 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
* it. */
{
Tcl_Token *tokenPtr;
- char *end, *src;
+ register CONST char *src;
unsigned char c;
int varIndex, offset;
Tcl_UniChar ch;
unsigned array;
- if (numBytes >= 0) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
+ }
+ if (numBytes < 0) {
+ numBytes = strlen(string);
}
if (!append) {
@@ -811,7 +1080,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
parsePtr->incomplete = 0;
@@ -833,8 +1102,8 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
varIndex = parsePtr->numTokens;
parsePtr->numTokens++;
tokenPtr++;
- src++;
- if (src >= end) {
+ src++; numBytes--;
+ if (numBytes == 0) {
goto justADollarSign;
}
tokenPtr->type = TCL_TOKEN_TEXT;
@@ -859,26 +1128,23 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
*/
if (*src == '{') {
- src++;
+ src++; numBytes--;
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (1) {
- if (src == end) {
- if (interp != NULL) {
- Tcl_SetResult(interp,
- "missing close-brace for variable name",
+
+ while (numBytes && (*src != '}')) {
+ numBytes--; src++;
+ }
+ if (numBytes == 0) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "missing close-brace for variable name",
TCL_STATIC);
- }
- parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
- parsePtr->term = tokenPtr->start-1;
- parsePtr->incomplete = 1;
- goto error;
- }
- if (*src == '}') {
- break;
}
- src++;
+ parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
+ parsePtr->term = tokenPtr->start-1;
+ parsePtr->incomplete = 1;
+ goto error;
}
tokenPtr->size = src - tokenPtr->start;
tokenPtr[-1].size = src - tokenPtr[-1].start;
@@ -888,17 +1154,24 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (src != end) {
- offset = Tcl_UtfToUniChar(src, &ch);
+ while (numBytes) {
+ if (Tcl_UtfCharComplete(src, numBytes)) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, src, (size_t) numBytes);
+ utfBytes[numBytes] = '\0';
+ offset = Tcl_UtfToUniChar(utfBytes, &ch);
+ }
c = UCHAR(ch);
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
- src += offset;
+ src += offset; numBytes -= offset;
continue;
}
- if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
- src += 2;
- while ((src != end) && (*src == ':')) {
- src += 1;
+ if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
+ src += 2; numBytes -= 2;
+ while (numBytes && (*src == ':')) {
+ src++; numBytes--;
}
continue;
}
@@ -908,9 +1181,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
/*
* Support for empty array names here.
*/
- array = ((src != end) && (*src == '('));
+ array = (numBytes && (*src == '('));
tokenPtr->size = src - tokenPtr->start;
- if (tokenPtr->size == 0 && !array) {
+ if ((tokenPtr->size == 0) && !array) {
goto justADollarSign;
}
parsePtr->numTokens++;
@@ -921,11 +1194,12 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
* since it could contain any number of substitutions.
*/
- if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
+ if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
!= TCL_OK) {
goto error;
}
- if ((parsePtr->term == end) || (*parsePtr->term != ')')) {
+ if ((parsePtr->term == (src + numBytes))
+ || (*parsePtr->term != ')')) {
if (parsePtr->interp != NULL) {
Tcl_SetResult(parsePtr->interp, "missing )",
TCL_STATIC);
@@ -960,7 +1234,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
Tcl_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -986,9 +1260,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
CONST char *
Tcl_ParseVar(interp, string, termPtr)
Tcl_Interp *interp; /* Context for looking up variable. */
- register char *string; /* String containing variable name.
+ register CONST char *string; /* String containing variable name.
* First character must be "$". */
- char **termPtr; /* If non-NULL, points to word to fill
+ CONST char **termPtr; /* If non-NULL, points to word to fill
* in with character just after last
* one in the variable specifier. */
@@ -1035,7 +1309,7 @@ Tcl_ParseVar(interp, string, termPtr)
Tcl_ResetResult(interp);
return TclGetString(objPtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1043,7 +1317,8 @@ Tcl_ParseVar(interp, string, termPtr)
*
* Given a string in braces such as a Tcl command argument or a string
* value in a Tcl expression, this procedure parses the string and
- * returns information about the parse.
+ * returns information about the parse. No more than numBytes bytes
+ * will be scanned.
*
* Results:
* The return value is TCL_OK if the string was parsed successfully and
@@ -1069,9 +1344,9 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing the string in braces.
+ CONST char *string; /* String containing the string in braces.
* The first character must be '{'. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to
* the first null character. */
register Tcl_Parse *parsePtr;
@@ -1081,35 +1356,35 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
* information in parsePtr; zero means
* ignore existing tokens in parsePtr and
* reinitialize it. */
- char **termPtr; /* If non-NULL, points to word in which to
+ CONST char **termPtr; /* If non-NULL, points to word in which to
* store a pointer to the character just
* after the terminating '}' if the parse
* was successful. */
{
- char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */
Tcl_Token *tokenPtr;
- register char *src, *end;
+ register CONST char *src;
int startIndex, level, length;
- if ((numBytes >= 0) || (string == NULL)) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
}
-
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+
if (!append) {
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
}
- src = string+1;
+ src = string;
startIndex = parsePtr->numTokens;
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
@@ -1117,59 +1392,17 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
}
tokenPtr = &parsePtr->tokenPtr[startIndex];
tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = src;
+ tokenPtr->start = src+1;
tokenPtr->numComponents = 0;
level = 1;
while (1) {
- while (CHAR_TYPE(*src) == TYPE_NORMAL) {
- src++;
- }
- if (*src == '}') {
- level--;
- if (level == 0) {
+ while (++src, --numBytes) {
+ if (CHAR_TYPE(*src) != TYPE_NORMAL) {
break;
}
- src++;
- } else if (*src == '{') {
- level++;
- src++;
- } else if (*src == '\\') {
- Tcl_UtfBackslash(src, &length, utfBytes);
- if (src[1] == '\n') {
- /*
- * A backslash-newline sequence must be collapsed, even
- * inside braces, so we have to split the word into
- * multiple tokens so that the backslash-newline can be
- * represented explicitly.
- */
-
- if ((src + 2) == end) {
- parsePtr->incomplete = 1;
- }
- tokenPtr->size = (src - tokenPtr->start);
- if (tokenPtr->size != 0) {
- parsePtr->numTokens++;
- }
- if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_BS;
- tokenPtr->start = src;
- tokenPtr->size = length;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- src += length;
- tokenPtr++;
- tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = src;
- tokenPtr->numComponents = 0;
- } else {
- src += length;
- }
- } else if (src == end) {
- register int openBrace; /* bool-flag for when scanning back */
+ }
+ if (numBytes == 0) {
+ register int openBrace = 0;
parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
parsePtr->term = string;
@@ -1177,7 +1410,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
if (interp == NULL) {
/*
* Skip straight to the exit code since we have no
- * interpreter to put error messages in.
+ * interpreter to put error message in.
*/
goto error;
}
@@ -1185,22 +1418,22 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
/*
- * Guess if the problem is due to comments by searching
- * the source string for a possible open brace within the
- * context of a comment. Since we aren't performing a
- * full Tcl parse, just look for an open brace preceeded
- * by a '<whitespace>#' on the same line.
+ * Guess if the problem is due to comments by searching
+ * the source string for a possible open brace within the
+ * context of a comment. Since we aren't performing a
+ * full Tcl parse, just look for an open brace preceded
+ * by a '<whitespace>#' on the same line.
*/
- openBrace = 0;
- for (; src>string ; src--) {
+
+ for (; src > string; src--) {
switch (*src) {
- case '{':
- openBrace = 1;
+ case '{':
+ openBrace = 1;
break;
case '\n':
- openBrace = 0;
+ openBrace = 0;
break;
- case '#':
+ case '#' :
if (openBrace && (isspace(UCHAR(src[-1])))) {
Tcl_AppendResult(interp,
": possible unbalanced brace in comment",
@@ -1210,37 +1443,84 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
break;
}
}
- goto error;
- } else {
- src++;
- }
- }
- /*
- * Decide if we need to finish emitting a partially-finished token.
- * There are 3 cases:
- * {abc \newline xyz} or {xyz} - finish emitting "xyz" token
- * {abc \newline} - don't emit token after \newline
- * {} - finish emitting zero-sized token
- * The last case ensures that there is a token (even if empty) that
- * describes the braced string.
- */
+ error:
+ Tcl_FreeParse(parsePtr);
+ return TCL_ERROR;
+ }
+ switch (*src) {
+ case '{':
+ level++;
+ break;
+ case '}':
+ if (--level == 0) {
+
+ /*
+ * Decide if we need to finish emitting a
+ * partially-finished token. There are 3 cases:
+ * {abc \newline xyz} or {xyz}
+ * - finish emitting "xyz" token
+ * {abc \newline}
+ * - don't emit token after \newline
+ * {} - finish emitting zero-sized token
+ *
+ * The last case ensures that there is a token
+ * (even if empty) that describes the braced string.
+ */
- if ((src != tokenPtr->start)
- || (parsePtr->numTokens == startIndex)) {
- tokenPtr->size = (src - tokenPtr->start);
- parsePtr->numTokens++;
- }
- if (termPtr != NULL) {
- *termPtr = src+1;
+ if ((src != tokenPtr->start)
+ || (parsePtr->numTokens == startIndex)) {
+ tokenPtr->size = (src - tokenPtr->start);
+ parsePtr->numTokens++;
+ }
+ if (termPtr != NULL) {
+ *termPtr = src+1;
+ }
+ return TCL_OK;
+ }
+ break;
+ case '\\':
+ TclParseBackslash(src, numBytes, &length, NULL);
+ if ((length > 1) && (src[1] == '\n')) {
+ /*
+ * A backslash-newline sequence must be collapsed, even
+ * inside braces, so we have to split the word into
+ * multiple tokens so that the backslash-newline can be
+ * represented explicitly.
+ */
+
+ if (numBytes == 2) {
+ parsePtr->incomplete = 1;
+ }
+ tokenPtr->size = (src - tokenPtr->start);
+ if (tokenPtr->size != 0) {
+ parsePtr->numTokens++;
+ }
+ if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_BS;
+ tokenPtr->start = src;
+ tokenPtr->size = length;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ src += length - 1;
+ numBytes -= length - 1;
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src + 1;
+ tokenPtr->numComponents = 0;
+ } else {
+ src += length - 1;
+ numBytes -= length - 1;
+ }
+ break;
+ }
}
- return TCL_OK;
-
- error:
- Tcl_FreeParse(parsePtr);
- return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1248,7 +1528,8 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
*
* Given a double-quoted string such as a quoted Tcl command argument
* or a quoted value in a Tcl expression, this procedure parses the
- * string and returns information about the parse.
+ * string and returns information about the parse. No more than
+ * numBytes bytes will be scanned.
*
* Results:
* The return value is TCL_OK if the string was parsed successfully and
@@ -1274,9 +1555,9 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing the quoted string.
+ CONST char *string; /* String containing the quoted string.
* The first character must be '"'. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to
* the first null character. */
register Tcl_Parse *parsePtr;
@@ -1286,31 +1567,30 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
* information in parsePtr; zero means
* ignore existing tokens in parsePtr and
* reinitialize it. */
- char **termPtr; /* If non-NULL, points to word in which to
+ CONST char **termPtr; /* If non-NULL, points to word in which to
* store a pointer to the character just
* after the quoted string's terminating
* close-quote if the parse succeeds. */
{
- char *end;
-
- if ((numBytes >= 0) || (string == NULL)) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
}
-
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+
if (!append) {
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
}
- if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+ if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
goto error;
}
if (*parsePtr->term != '"') {
@@ -1331,7 +1611,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1353,16 +1633,16 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
*/
static int
-CommandComplete(script, length)
- char *script; /* Script to check. */
- int length; /* Number of bytes in script. */
+CommandComplete(script, numBytes)
+ CONST char *script; /* Script to check. */
+ int numBytes; /* Number of bytes in script. */
{
Tcl_Parse parse;
- char *p, *end;
+ CONST char *p, *end;
int result;
p = script;
- end = p + length;
+ end = p + numBytes;
while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
== TCL_OK) {
p = parse.commandStart + parse.commandSize;
@@ -1379,7 +1659,7 @@ CommandComplete(script, length)
Tcl_FreeParse(&parse);
return result;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1402,11 +1682,11 @@ CommandComplete(script, length)
int
Tcl_CommandComplete(script)
- char *script; /* Script to check. */
+ CONST char *script; /* Script to check. */
{
return CommandComplete(script, (int) strlen(script));
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1430,13 +1710,13 @@ TclObjCommandComplete(objPtr)
Tcl_Obj *objPtr; /* Points to object holding script
* to check. */
{
- char *script;
+ CONST char *script;
int length;
script = Tcl_GetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
-
+
/*
*----------------------------------------------------------------------
*