summaryrefslogtreecommitdiffstats
path: root/generic/tclParse.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /generic/tclParse.c
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r--generic/tclParse.c2544
1 files changed, 1915 insertions, 629 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c
index b822c24..679b039 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1,727 +1,1744 @@
/*
* tclParse.c --
*
- * This file contains a collection of procedures that are used
- * to parse Tcl commands or parts of commands (like quoted
- * strings or nested sub-commands).
+ * This file contains procedures that parse Tcl scripts. They
+ * do so in a general-purpose fashion that can be used for many
+ * different purposes, including compilation, direct execution,
+ * code analysis, etc. This file also includes a few additional
+ * procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which
+ * allow scripts to be evaluated directly, without compiling.
*
- * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* 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.2 1998/09/14 18:40:01 stanton Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.3 1999/04/16 00:46:51 stanton Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
/*
- * Function prototypes for procedures local to this file:
+ * The following table provides parsing information about each possible
+ * 8-bit character. The table is designed to be referenced with either
+ * signed or unsigned characters, so it has 384 entries. The first 128
+ * entries correspond to negative character values, the next 256 correspond
+ * to positive character values. The last 128 entries are identical to the
+ * first 128. The table is always indexed with a 128-byte offset (the 128th
+ * entry corresponds to a character value of 0).
+ *
+ * The macro CHAR_TYPE is used to index into the table and return
+ * 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).
+ */
+
+#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)]
+
+char typeTable[] = {
+ /*
+ * Negative character values, from -128 to -1:
+ */
+
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+
+ /*
+ * Positive character values, from 0-127:
+ */
+
+ TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE,
+ TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL,
+ TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS,
+ TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE,
+ TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL,
+
+ /*
+ * Large unsigned character values, from 128-255:
+ */
+
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
*/
-static char * QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
- int term));
-static char * ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
- int nested));
-static char * VarNameEnd _ANSI_ARGS_((char *string, char *lastChar));
+static int CommandComplete _ANSI_ARGS_((char *script,
+ int length));
+static int ParseTokens _ANSI_ARGS_((char *src, int mask,
+ Tcl_Parse *parsePtr));
+static int EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], char *command, int length,
+ int flags));
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclParseQuotes --
+ * Tcl_ParseCommand --
*
- * This procedure parses a double-quoted string such as a
- * quoted Tcl command argument or a quoted value in a Tcl
- * expression. This procedure is also used to parse array
- * element names within parentheses, or anything else that
- * needs all the substitutions that happen in quotes.
+ * Given a string, this procedure parses the first Tcl command
+ * in the string and returns information about the structure of
+ * the command.
*
* Results:
- * The return value is a standard Tcl result, which is
- * TCL_OK unless there was an error while parsing the
- * quoted string. If an error occurs then interp->result
- * contains a standard error message. *TermPtr is filled
- * in with the address of the character just after the
- * last one successfully processed; this is usually the
- * character just after the matching close-quote. The
- * fully-substituted contents of the quotes are stored in
- * standard fashion in *pvPtr, null-terminated with
- * pvPtr->next pointing to the terminating null character.
+ * The return value is TCL_OK if the command was parsed
+ * successfully and TCL_ERROR otherwise. If an error occurs
+ * and interp isn't NULL then an error message is left in
+ * its result. On a successful return, parsePtr is filled in
+ * with information about the command that was parsed.
*
* Side effects:
- * The buffer space in pvPtr may be enlarged by calling its
- * expandProc.
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
-TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening double-
- * quote. */
- int termChar; /* Character that terminates "quoted" string
- * (usually double-quote, but sometimes
- * right-paren or something else). */
- int flags; /* Flags to pass to nested Tcl_Eval calls. */
- char **termPtr; /* Store address of terminating character
- * here. */
- ParseValue *pvPtr; /* Information about where to place
- * fully-substituted result of parse. */
+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,
+ * the script consists of all bytes up to
+ * the first null character. */
+ int nested; /* Non-zero means this is a nested command:
+ * close bracket should be considered
+ * a command terminator. If zero, then close
+ * bracket has no special meaning. */
+ register Tcl_Parse *parsePtr;
+ /* Structure to fill in with information
+ * about the parsed command; any previous
+ * information in the structure is
+ * ignored. */
{
- register char *src, *dst, c;
- char *lastChar = string + strlen(string);
+ register char *src; /* Points to current character
+ * in the command. */
+ int 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
+ * point to char after terminating one. */
+ int length, savedChar;
- src = string;
- dst = pvPtr->next;
+ if (numBytes < 0) {
+ numBytes = (string? strlen(string) : 0);
+ }
+ parsePtr->commentStart = NULL;
+ parsePtr->commentSize = 0;
+ parsePtr->commandStart = NULL;
+ parsePtr->commandSize = 0;
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = string + numBytes;
+ parsePtr->interp = interp;
+ parsePtr->incomplete = 0;
+ if (nested != 0) {
+ terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
+ } else {
+ terminators = TYPE_COMMAND_END;
+ }
+
+ /*
+ * 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];
+ string[numBytes] = 0;
+
+ /*
+ * Parse any leading space and comments before the first word of the
+ * command.
+ */
+
+ src = string;
while (1) {
- if (dst == pvPtr->end) {
+ while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
+ src++;
+ }
+ if ((*src == '\\') && (src[1] == '\n')) {
/*
- * Target buffer space is about to run out. Make more space.
+ * Skip backslash-newline sequence: it should be treated
+ * just like white space.
*/
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, 1);
- dst = pvPtr->next;
+ 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++;
+ }
+ }
+ }
+
+ /*
+ * The following loop parses the words of the command, one word
+ * in each iteration through the loop.
+ */
+
+ parsePtr->commandStart = src;
+ while (1) {
+ /*
+ * Create the token for the word.
+ */
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
}
+ wordIndex = parsePtr->numTokens;
+ tokenPtr = &parsePtr->tokenPtr[wordIndex];
+ tokenPtr->type = TCL_TOKEN_WORD;
- c = *src;
- src++;
- if (c == termChar) {
- *dst = '\0';
- pvPtr->next = dst;
- *termPtr = src;
- return TCL_OK;
- } else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
- copy:
- *dst = c;
- dst++;
- continue;
- } else if (c == '$') {
- int length;
- char *value;
+ /*
+ * Skip white space before the word. Also skip a backslash-newline
+ * sequence: it should be treated just like white space.
+ */
- value = Tcl_ParseVar(interp, src-1, termPtr);
- if (value == NULL) {
- return TCL_ERROR;
+ 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;
}
- src = *termPtr;
- length = strlen(value);
- if ((pvPtr->end - dst) <= length) {
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, length);
- dst = pvPtr->next;
+ break;
+ }
+ if ((type & terminators) != 0) {
+ src++;
+ break;
+ }
+ if (src == parsePtr->end) {
+ break;
+ }
+ tokenPtr->start = src;
+ parsePtr->numTokens++;
+ parsePtr->numWords++;
+
+ /*
+ * At this point the word can have one of three forms: something
+ * enclosed in quotes, something enclosed in braces, or an
+ * unquoted word (anything else).
+ */
+
+ if (*src == '"') {
+ if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
+ parsePtr, 1, &termPtr) != TCL_OK) {
+ goto error;
}
- strcpy(dst, value);
- dst += length;
- continue;
- } else if (c == '[') {
- int result;
+ src = termPtr;
+ } else if (*src == '{') {
+ if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
+ parsePtr, 1, &termPtr) != TCL_OK) {
+ goto error;
+ }
+ src = termPtr;
+ } else {
+ /*
+ * This is an unquoted word. Call ParseTokens and let it do
+ * all of the work.
+ */
- pvPtr->next = dst;
- result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
- if (result != TCL_OK) {
- return result;
+ if (ParseTokens(src, TYPE_SPACE|terminators,
+ parsePtr) != TCL_OK) {
+ goto error;
}
- src = *termPtr;
- dst = pvPtr->next;
- continue;
- } else if (c == '\\') {
- int numRead;
+ src = parsePtr->term;
+ }
- src--;
- *dst = Tcl_Backslash(src, &numRead);
- dst++;
- src += numRead;
+ /*
+ * Finish filling in the token for the word and check for the
+ * special case of a word consisting of a single range of
+ * literal text.
+ */
+
+ tokenPtr = &parsePtr->tokenPtr[wordIndex];
+ tokenPtr->size = src - tokenPtr->start;
+ tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
+ if ((tokenPtr->numComponents == 1)
+ && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
+ tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
+ }
+
+ /*
+ * Do two additional checks: (a) make sure we're really at the
+ * end of a word (there might have been garbage left after a
+ * quoted or braced word), and (b) check for the end of the
+ * command.
+ */
+
+ type = CHAR_TYPE(*src);
+ if (type == TYPE_SPACE) {
+ src++;
continue;
- } else if (c == '\0') {
- char buf[30];
-
- Tcl_ResetResult(interp);
- sprintf(buf, "missing %c", termChar);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- *termPtr = string-1;
- return TCL_ERROR;
} else {
- goto copy;
+ /*
+ * 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) {
+ src++;
+ break;
}
+ if (src == parsePtr->end) {
+ break;
+ }
+ if (interp != NULL) {
+ if (src[-1] == '"') {
+ Tcl_SetResult(interp, "extra characters after close-quote",
+ TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "extra characters after close-brace",
+ TCL_STATIC);
+ }
+ }
+ parsePtr->term = src;
+ goto error;
+ }
+
+
+ parsePtr->commandSize = src - parsePtr->commandStart;
+ string[numBytes] = (char) savedChar;
+ return TCL_OK;
+
+ error:
+ string[numBytes] = (char) savedChar;
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ if (parsePtr->commandStart == NULL) {
+ parsePtr->commandStart = string;
}
+ parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
+ return TCL_ERROR;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclParseNestedCmd --
+ * ParseTokens --
*
- * This procedure parses a nested Tcl command between
- * brackets, returning the result of the command.
+ * 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.
*
* Results:
- * The return value is a standard Tcl result, which is
- * TCL_OK unless there was an error while executing the
- * nested command. If an error occurs then interp->result
- * contains a standard error message. *TermPtr is filled
- * in with the address of the character just after the
- * last one processed; this is usually the character just
- * after the matching close-bracket, or the null character
- * at the end of the string if the close-bracket was missing
- * (a missing close bracket is an error). The result returned
- * by the command is stored in standard fashion in *pvPtr,
- * null-terminated, with pvPtr->next pointing to the null
- * character.
+ * Tokens are added to parsePtr and parsePtr->term is filled in
+ * with the address of the character that terminated the parse (the
+ * first one whose CHAR_TYPE matched mask or the character at
+ * parsePtr->end). The return value is TCL_OK if the parse
+ * completed successfully and TCL_ERROR otherwise. If a parse
+ * error occurs and parsePtr->interp isn't NULL, then an error
+ * message is left in the interpreter's result.
*
* Side effects:
- * The storage space at *pvPtr may be expanded.
+ * None.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-int
-TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening bracket. */
- int flags; /* Flags to pass to nested Tcl_Eval. */
- char **termPtr; /* Store address of terminating character
- * here. */
- register ParseValue *pvPtr; /* Information about where to place
- * result of command. */
+static int
+ParseTokens(src, mask, parsePtr)
+ register char *src; /* First character to parse. */
+ int mask; /* Specifies when to stop parsing. The
+ * parse stops at the first unquoted
+ * character whose CHAR_TYPE contains
+ * any of the bits in mask. */
+ Tcl_Parse *parsePtr; /* Information about parse in progress.
+ * Updated with additional tokens and
+ * termination information. */
{
- int result, length, shortfall;
- Interp *iPtr = (Interp *) interp;
+ int type, originalTokens, varToken;
+ char utfBytes[TCL_UTF_MAX];
+ Tcl_Token *tokenPtr;
+ Tcl_Parse nested;
- iPtr->evalFlags = flags | TCL_BRACKET_TERM;
- result = Tcl_Eval(interp, string);
- *termPtr = (string + iPtr->termOffset);
- if (result != TCL_OK) {
- /*
- * The increment below results in slightly cleaner message in
- * the errorInfo variable (the close-bracket will appear).
- */
+ /*
+ * Each iteration through the following loop adds one token of
+ * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
+ * TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens,
+ * additional tokens are added for the parsed variable name.
+ */
+
+ originalTokens = parsePtr->numTokens;
+ while (1) {
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
- if (**termPtr == ']') {
- *termPtr += 1;
+ 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;
+ }
+ }
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = src - tokenPtr->start;
+ parsePtr->numTokens++;
+ } else if (*src == '$') {
+ /*
+ * This is a variable reference. Call Tcl_ParseVarName to do
+ * all the dirty work of parsing the name.
+ */
+
+ varToken = parsePtr->numTokens;
+ if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
+ parsePtr, 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ src += parsePtr->tokenPtr[varToken].size;
+ } else if (*src == '[') {
+ /*
+ * Command substitution. Call Tcl_ParseCommand recursively
+ * (and repeatedly) to parse the nested command(s), then
+ * throw away the parse information.
+ */
+
+ src++;
+ while (1) {
+ if (Tcl_ParseCommand(parsePtr->interp, src,
+ parsePtr->end - src, 1, &nested) != TCL_OK) {
+ parsePtr->term = nested.term;
+ parsePtr->incomplete = nested.incomplete;
+ return TCL_ERROR;
+ }
+ src = nested.commandStart + nested.commandSize;
+ if (nested.tokenPtr != nested.staticTokens) {
+ ckfree((char *) nested.tokenPtr);
+ }
+ if ((src[-1] == ']') && !nested.incomplete) {
+ break;
+ }
+ if (src == parsePtr->end) {
+ if (parsePtr->interp != NULL) {
+ Tcl_SetResult(parsePtr->interp,
+ "missing close-bracket", TCL_STATIC);
+ }
+ parsePtr->term = tokenPtr->start;
+ parsePtr->incomplete = 1;
+ return TCL_ERROR;
+ }
+ }
+ tokenPtr->type = TCL_TOKEN_COMMAND;
+ tokenPtr->size = src - tokenPtr->start;
+ parsePtr->numTokens++;
+ } else if (*src == '\\') {
+ /*
+ * Backslash substitution.
+ */
+
+ if (src[1] == '\n') {
+ if ((src + 2) == parsePtr->end) {
+ parsePtr->incomplete = 1;
+ }
+
+ /*
+ * Note: backslash-newline is special in that it is
+ * treated the same as a space character would be. This
+ * means that it could terminate the token.
+ */
+
+ if (mask & TYPE_SPACE) {
+ break;
+ }
+ }
+ tokenPtr->type = TCL_TOKEN_BS;
+ Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
+ parsePtr->numTokens++;
+ src += 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++;
+ } else {
+ panic("ParseTokens encountered unknown character");
}
- return result;
}
- (*termPtr) += 1;
- length = strlen(iPtr->result);
- shortfall = length + 1 - (pvPtr->end - pvPtr->next);
- if (shortfall > 0) {
- (*pvPtr->expandProc)(pvPtr, shortfall);
+ if (parsePtr->numTokens == originalTokens) {
+ /*
+ * There was nothing in this range of text. Add an empty token
+ * for the empty range, so that there is always at least one
+ * token added.
+ */
+
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = 0;
+ parsePtr->numTokens++;
}
- strcpy(pvPtr->next, iPtr->result);
- pvPtr->next += length;
-
- Tcl_FreeResult(interp);
- iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = '\0';
+ parsePtr->term = src;
return TCL_OK;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclParseBraces --
+ * Tcl_FreeParse --
*
- * This procedure scans the information between matching
- * curly braces.
+ * This procedure is invoked to free any dynamic storage that may
+ * have been allocated by a previous call to Tcl_ParseCommand.
*
* Results:
- * The return value is a standard Tcl result, which is
- * TCL_OK unless there was an error while parsing string.
- * If an error occurs then interp->result contains a
- * standard error message. *TermPtr is filled
- * in with the address of the character just after the
- * last one successfully processed; this is usually the
- * character just after the matching close-brace. The
- * information between curly braces is stored in standard
- * fashion in *pvPtr, null-terminated with pvPtr->next
- * pointing to the terminating null character.
+ * None.
*
* Side effects:
- * The storage space at *pvPtr may be expanded.
+ * If there is any dynamically allocated memory in *parsePtr,
+ * it is freed.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-int
-TclParseBraces(interp, string, termPtr, pvPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening bracket. */
- char **termPtr; /* Store address of terminating character
- * here. */
- register ParseValue *pvPtr; /* Information about where to place
- * result of command. */
+void
+Tcl_FreeParse(parsePtr)
+ Tcl_Parse *parsePtr; /* Structure that was filled in by a
+ * previous call to Tcl_ParseCommand. */
{
- int level;
- register char *src, *dst, *end;
- register char c;
- char *lastChar = string + strlen(string);
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExpandTokenArray --
+ *
+ * This procedure is invoked when the current space for tokens in
+ * a Tcl_Parse structure fills up; it allocates memory to grow the
+ * token array
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is allocated for a new larger token array; the memory
+ * for the old array is freed, if it had been dynamically allocated.
+ *
+ *----------------------------------------------------------------------
+ */
- src = string;
- dst = pvPtr->next;
- end = pvPtr->end;
- level = 1;
+void
+TclExpandTokenArray(parsePtr)
+ Tcl_Parse *parsePtr; /* Parse structure whose token space
+ * has overflowed. */
+{
+ int newCount;
+ Tcl_Token *newPtr;
+
+ newCount = parsePtr->tokensAvailable*2;
+ newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
+ memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
+ (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ parsePtr->tokenPtr = newPtr;
+ parsePtr->tokensAvailable = newCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvalObjv --
+ *
+ * This procedure evaluates a Tcl command that has already been
+ * parsed into words, with one Tcl_Obj holding each word.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR. A result or error message is left in
+ * interp's result. If an error occurs, this procedure does
+ * NOT add any information to the errorInfo variable.
+ *
+ * Side effects:
+ * Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EvalObjv(interp, objc, objv, command, length, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * command. Also used for error
+ * reporting. */
+ int objc; /* Number of words in command. */
+ Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
+ * the words that make up the command. */
+ char *command; /* Points to the beginning of the string
+ * representation of the command; this
+ * is used for traces. If the string
+ * representation of the command is
+ * unknown, an empty string should be
+ * supplied. */
+ int length; /* Number of bytes in command; if -1, all
+ * characters up to the first null byte are
+ * used. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
+
+{
+ Command *cmdPtr;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj **newObjv;
+ int i, code;
+ Trace *tracePtr, *nextPtr;
+ char **argv, *commandCopy;
+ CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
+ * in case TCL_EVAL_GLOBAL was set. */
+
+ Tcl_ResetResult(interp);
+ if (objc == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If the interpreter was deleted, return an error.
+ */
+
+ if (iPtr->flags & DELETED) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "attempt to call eval in deleted interpreter", -1);
+ Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+ "attempt to call eval in deleted interpreter",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
/*
- * Copy the characters one at a time to the result area, stopping
- * when the matching close-brace is found.
+ * Check depth of nested calls to Tcl_Eval: if this gets too large,
+ * it's probably because of an infinite loop somewhere.
*/
- while (1) {
- c = *src;
- src++;
- if (dst == end) {
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, 20);
- dst = pvPtr->next;
- end = pvPtr->end;
- }
- *dst = c;
- dst++;
- if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
+ if (iPtr->numLevels >= iPtr->maxNestingDepth) {
+ iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
+ return TCL_ERROR;
+ }
+ iPtr->numLevels++;
+
+ /*
+ * On the Mac, we will never reach the default recursion limit before
+ * blowing the stack. So we need to do a check here.
+ */
+
+ if (TclpCheckStackSpace() == 0) {
+ /*NOTREACHED*/
+ iPtr->numLevels--;
+ iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the procedure to execute this command. If there isn't one,
+ * then see if there is a command "unknown". If so, create a new
+ * word array with "unknown" as the first word and the original
+ * command words as arguments. Then call ourselves recursively
+ * to execute it.
+ */
+
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+ if (cmdPtr == NULL) {
+ newObjv = (Tcl_Obj **) ckalloc((unsigned)
+ ((objc + 1) * sizeof (Tcl_Obj *)));
+ for (i = objc-1; i >= 0; i--) {
+ newObjv[i+1] = objv[i];
+ }
+ newObjv[0] = Tcl_NewStringObj("unknown", -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+ if (cmdPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid command name \"", Tcl_GetString(objv[0]), "\"",
+ (char *) NULL);
+ code = TCL_ERROR;
+ } else {
+ code = EvalObjv(interp, objc+1, newObjv, command, length, 0);
+ }
+ Tcl_DecrRefCount(newObjv[0]);
+ ckfree((char *) newObjv);
+ goto done;
+ }
+
+ /*
+ * Call trace procedures if needed.
+ */
+
+ argv = NULL;
+ commandCopy = command;
+
+ for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
+ nextPtr = tracePtr->nextPtr;
+ if (iPtr->numLevels > tracePtr->level) {
continue;
- } else if (c == '{') {
- level++;
- } else if (c == '}') {
- level--;
- if (level == 0) {
- dst--; /* Don't copy the last close brace. */
- break;
- }
- } else if (c == '\\') {
- int count;
+ }
- /*
- * Must always squish out backslash-newlines, even when in
- * braces. This is needed so that this sequence can appear
- * anywhere in a command, such as the middle of an expression.
- */
+ /*
+ * This is a bit messy because we have to emulate the old trace
+ * interface, which uses strings for everything.
+ */
- if (*src == '\n') {
- dst[-1] = Tcl_Backslash(src-1, &count);
- src += count - 1;
- } else {
- (void) Tcl_Backslash(src-1, &count);
- while (count > 1) {
- if (dst == end) {
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, 20);
- dst = pvPtr->next;
- end = pvPtr->end;
- }
- *dst = *src;
- dst++;
- src++;
- count--;
- }
+ if (argv == NULL) {
+ argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[objc] = 0;
+
+ if (length < 0) {
+ length = strlen(command);
+ } else if ((size_t)length < strlen(command)) {
+ commandCopy = (char *) ckalloc((unsigned) (length + 1));
+ strncpy(commandCopy, command, (size_t) length);
+ commandCopy[length] = 0;
}
- } else if (c == '\0') {
- Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
- *termPtr = string-1;
- return TCL_ERROR;
}
+ (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
+ commandCopy, cmdPtr->proc, cmdPtr->clientData,
+ objc, argv);
+ }
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ if (commandCopy != command) {
+ ckfree((char *) commandCopy);
+ }
+
+ /*
+ * Finally, invoke the command's Tcl_ObjCmdProc.
+ */
+
+ iPtr->cmdCount++;
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+ code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ iPtr->varFramePtr = savedVarFramePtr;
+ if (Tcl_AsyncReady()) {
+ code = Tcl_AsyncInvoke(interp, code);
}
- *dst = '\0';
- pvPtr->next = dst;
- *termPtr = src;
- return TCL_OK;
+ /*
+ * If the interpreter has a non-empty string result, the result
+ * object is either empty or stale because some procedure set
+ * interp->result directly. If so, move the string result to the
+ * result object, then reset the string result.
+ */
+
+ if (*(iPtr->result) != 0) {
+ (void) Tcl_GetObjResult(interp);
+ }
+
+ done:
+ iPtr->numLevels--;
+ return code;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclExpandParseValue --
+ * Tcl_EvalObjv --
*
- * This procedure is commonly used as the value of the
- * expandProc in a ParseValue. It uses malloc to allocate
- * more space for the result of a parse.
+ * This procedure evaluates a Tcl command that has already been
+ * parsed into words, with one Tcl_Obj holding each word.
*
* Results:
- * The buffer space in *pvPtr is reallocated to something
- * larger, and if pvPtr->clientData is non-zero the old
- * buffer is freed. Information is copied from the old
- * buffer to the new one.
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR. A result or error message is left in
+ * interp's result.
*
* Side effects:
- * None.
+ * Depends on the command.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-void
-TclExpandParseValue(pvPtr, needed)
- register ParseValue *pvPtr; /* Information about buffer that
- * must be expanded. If the clientData
- * in the structure is non-zero, it
- * means that the current buffer is
- * dynamically allocated. */
- int needed; /* Minimum amount of additional space
- * to allocate. */
+int
+Tcl_EvalObjv(interp, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * command. Also used for error
+ * reporting. */
+ int objc; /* Number of words in command. */
+ Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
+ * the words that make up the command. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
{
- int newSpace;
- char *new;
+ Interp *iPtr = (Interp *)interp;
+ Trace *tracePtr;
+ Tcl_DString cmdBuf;
+ char *cmdString = "";
+ int cmdLen = 0;
+ int code = TCL_OK;
- /*
- * Either double the size of the buffer or add enough new space
- * to meet the demand, whichever produces a larger new buffer.
- */
-
- newSpace = (pvPtr->end - pvPtr->buffer) + 1;
- if (newSpace < needed) {
- newSpace += needed;
- } else {
- newSpace += newSpace;
+ for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
+ /*
+ * EvalObjv will increment numLevels so use "<" rather than "<="
+ */
+ if (iPtr->numLevels < tracePtr->level) {
+ int i;
+ /*
+ * The command will be needed for an execution trace or stack trace
+ * generate a command string.
+ */
+ cmdtraced:
+ Tcl_DStringInit(&cmdBuf);
+ for (i = 0; i < objc; i++) {
+ Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
+ }
+ cmdString = Tcl_DStringValue(&cmdBuf);
+ cmdLen = Tcl_DStringLength(&cmdBuf);
+ break;
+ }
}
- new = (char *) ckalloc((unsigned) newSpace);
/*
- * Copy from old buffer to new, free old buffer if needed, and
- * mark new buffer as malloc-ed.
+ * Execute the command if we have not done so already
*/
+ switch (code) {
+ case TCL_OK:
+ code = EvalObjv(interp, objc, objv, cmdString, cmdLen, flags);
+ if (code == TCL_ERROR && cmdLen == 0)
+ goto cmdtraced;
+ break;
+ case TCL_ERROR:
+ Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+ break;
+ default:
+ /*NOTREACHED*/
+ break;
+ }
- memcpy((VOID *) new, (VOID *) pvPtr->buffer,
- (size_t) (pvPtr->next - pvPtr->buffer));
- pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
- if (pvPtr->clientData != 0) {
- ckfree(pvPtr->buffer);
+ if (cmdLen != 0) {
+ Tcl_DStringFree(&cmdBuf);
}
- pvPtr->buffer = new;
- pvPtr->end = new + newSpace - 1;
- pvPtr->clientData = (ClientData) 1;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * TclWordEnd --
+ * Tcl_LogCommandInfo --
*
- * Given a pointer into a Tcl command, find the end of the next
- * word of the command.
+ * This procedure is invoked after an error occurs in an interpreter.
+ * It adds information to the "errorInfo" variable to describe the
+ * command that was being executed when the error occurred.
*
* Results:
- * The return value is a pointer to the last character that's part
- * of the word pointed to by "start". If the word doesn't end
- * properly within the string then the return value is the address
- * of the null character at the end of the string.
+ * None.
*
* Side effects:
- * None.
+ * Information about the command is added to errorInfo and the
+ * line number stored internally in the interpreter is set. If this
+ * is the first call to this procedure or Tcl_AddObjErrorInfo since
+ * an error occurred, then old information in errorInfo is
+ * deleted.
*
*----------------------------------------------------------------------
*/
-char *
-TclWordEnd(start, lastChar, nested, semiPtr)
- char *start; /* Beginning of a word of a Tcl command. */
- char *lastChar; /* Terminating character in string. */
- int nested; /* Zero means this is a top-level command.
- * One means this is a nested command (close
- * bracket is a word terminator). */
- int *semiPtr; /* Set to 1 if word ends with a command-
- * terminating semi-colon, zero otherwise.
- * If NULL then ignored. */
+void
+Tcl_LogCommandInfo(interp, script, command, length)
+ Tcl_Interp *interp; /* Interpreter in which to log information. */
+ char *script; /* First character in script containing
+ * command (must be <= command). */
+ char *command; /* First character in command that
+ * generated the error. */
+ int length; /* Number of bytes in command (-1 means
+ * use all bytes up to first null byte). */
{
+ char buffer[200];
register char *p;
- int count;
+ char *ellipsis = "";
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->flags & ERR_ALREADY_LOGGED) {
+ /*
+ * Someone else has already logged error information for this
+ * command; we shouldn't add anything more.
+ */
- if (semiPtr != NULL) {
- *semiPtr = 0;
+ return;
}
/*
- * Skip leading white space (backslash-newline must be treated like
- * white-space, except that it better not be the last thing in the
- * command).
+ * Compute the line number where the error occurred.
*/
- for (p = start; ; p++) {
- if (isspace(UCHAR(*p))) {
- continue;
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
}
- if ((p[0] == '\\') && (p[1] == '\n')) {
- if (p+2 == lastChar) {
- return p+2;
- }
- continue;
- }
- break;
}
/*
- * Handle words beginning with a double-quote or a brace.
+ * Create an error message to add to errorInfo, including up to a
+ * maximum number of characters of the command.
*/
- if (*p == '"') {
- p = QuoteEnd(p+1, lastChar, '"');
- if (p == lastChar) {
- return p;
- }
- p++;
- } else if (*p == '{') {
- int braces = 1;
- while (braces != 0) {
- p++;
- while (*p == '\\') {
- (void) Tcl_Backslash(p, &count);
- p += count;
- }
- if (*p == '}') {
- braces--;
- } else if (*p == '{') {
- braces++;
- } else if (p == lastChar) {
- return p;
- }
- }
- p++;
+ if (length < 0) {
+ length = strlen(command);
+ }
+ if (length > 150) {
+ length = 150;
+ ellipsis = "...";
}
+ if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+ sprintf(buffer, "\n while executing\n\"%.*s%s\"",
+ length, command, ellipsis);
+ } else {
+ sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
+ length, command, ellipsis);
+ }
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalTokens --
+ *
+ * Given an array of tokens parsed from a Tcl command (e.g., the
+ * tokens that make up a word or the index for an array variable)
+ * this procedure evaluates the tokens and concatenates their
+ * values to form a single result value.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated Tcl_Obj
+ * containing the value of the array of tokens. The reference
+ * count of the returned object has been incremented. If an error
+ * occurs in evaluating the tokens then a NULL value is returned
+ * and an error message is left in interp's result.
+ *
+ * Side effects:
+ * A new object is allocated to hold the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_EvalTokens(interp, tokenPtr, count)
+ Tcl_Interp *interp; /* Interpreter in which to lookup
+ * variables, execute nested commands,
+ * and report errors. */
+ Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
+ * to evaluate and concatenate. */
+ int count; /* Number of tokens to consider at tokenPtr.
+ * Must be at least 1. */
+{
+ Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr;
+ char buffer[TCL_UTF_MAX];
+#ifdef TCL_MEM_DEBUG
+# define MAX_VAR_CHARS 5
+#else
+# define MAX_VAR_CHARS 30
+#endif
+ char nameBuffer[MAX_VAR_CHARS+1];
+ char *varName, *index;
+ char *p = NULL; /* Initialized to avoid compiler warning. */
+ int length, code;
/*
- * Handle words that don't start with a brace or double-quote.
- * This code is also invoked if the word starts with a brace or
- * double-quote and there is garbage after the closing brace or
- * quote. This is an error as far as Tcl_Eval is concerned, but
- * for here the garbage is treated as part of the word.
+ * The only tricky thing about this procedure is that it attempts to
+ * avoid object creation and string copying whenever possible. For
+ * example, if the value is just a nested command, then use the
+ * command's result object directly.
*/
- while (1) {
- if (*p == '[') {
- p = ScriptEnd(p+1, lastChar, 1);
- if (p == lastChar) {
- return p;
- }
- p++;
- } else if (*p == '\\') {
- if (p[1] == '\n') {
- /*
- * Backslash-newline: it maps to a space character
- * that is a word separator, so the word ends just before
- * the backslash.
- */
+ resultPtr = NULL;
+ for ( ; count > 0; count--, tokenPtr++) {
+ valuePtr = NULL;
- return p-1;
- }
- (void) Tcl_Backslash(p, &count);
- p += count;
- } else if (*p == '$') {
- p = VarNameEnd(p, lastChar);
- if (p == lastChar) {
- return p;
- }
- p++;
- } else if (*p == ';') {
- /*
- * Include the semi-colon in the word that is returned.
- */
+ /*
+ * The switch statement below computes the next value to be
+ * concat to the result, as either a range of text or an
+ * object.
+ */
+
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_TEXT:
+ p = tokenPtr->start;
+ length = tokenPtr->size;
+ break;
+
+ case TCL_TOKEN_BS:
+ length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
+ buffer);
+ p = buffer;
+ break;
+
+ case TCL_TOKEN_COMMAND:
+ code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
+ 0);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ valuePtr = Tcl_GetObjResult(interp);
+ break;
+
+ case TCL_TOKEN_VARIABLE:
+ if (tokenPtr->numComponents == 1) {
+ indexPtr = NULL;
+ } else {
+ indexPtr = Tcl_EvalTokens(interp, tokenPtr+2,
+ tokenPtr->numComponents - 1);
+ if (indexPtr == NULL) {
+ goto error;
+ }
+ }
- if (semiPtr != NULL) {
- *semiPtr = 1;
- }
- return p;
- } else if (isspace(UCHAR(*p))) {
- return p-1;
- } else if ((*p == ']') && nested) {
- return p-1;
- } else if (p == lastChar) {
- if (nested) {
/*
- * Nested commands can't end because of the end of the
- * string.
+ * We have to make a copy of the variable name in order
+ * to have a null-terminated string. We can't make a
+ * temporary modification to the script to null-terminate
+ * the name, because a trace callback might potentially
+ * reuse the script and be affected by the null character.
*/
- return p;
+
+ if (tokenPtr[1].size <= MAX_VAR_CHARS) {
+ varName = nameBuffer;
+ } else {
+ varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
+ }
+ strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
+ varName[tokenPtr[1].size] = 0;
+ if (indexPtr != NULL) {
+ index = TclGetString(indexPtr);
+ } else {
+ index = NULL;
+ }
+ valuePtr = Tcl_GetVar2Ex(interp, varName, index,
+ TCL_LEAVE_ERR_MSG);
+ if (varName != nameBuffer) {
+ ckfree(varName);
+ }
+ if (indexPtr != NULL) {
+ Tcl_DecrRefCount(indexPtr);
+ }
+ if (valuePtr == NULL) {
+ goto error;
+ }
+ count -= tokenPtr->numComponents;
+ tokenPtr += tokenPtr->numComponents;
+ break;
+
+ default:
+ panic("unexpected token type in Tcl_EvalTokens");
+ }
+
+ /*
+ * If valuePtr isn't NULL, the next piece of text comes from that
+ * object; otherwise, take length bytes starting at p.
+ */
+
+ if (resultPtr == NULL) {
+ if (valuePtr != NULL) {
+ resultPtr = valuePtr;
+ } else {
+ resultPtr = Tcl_NewStringObj(p, length);
}
- return p-1;
+ Tcl_IncrRefCount(resultPtr);
} else {
- p++;
+ if (Tcl_IsShared(resultPtr)) {
+ newPtr = Tcl_DuplicateObj(resultPtr);
+ Tcl_DecrRefCount(resultPtr);
+ resultPtr = newPtr;
+ Tcl_IncrRefCount(resultPtr);
+ }
+ if (valuePtr != NULL) {
+ p = Tcl_GetStringFromObj(valuePtr, &length);
+ }
+ Tcl_AppendToObj(resultPtr, p, length);
}
}
+ return resultPtr;
+
+ error:
+ if (resultPtr != NULL) {
+ Tcl_DecrRefCount(resultPtr);
+ }
+ return NULL;
}
/*
*----------------------------------------------------------------------
*
- * QuoteEnd --
+ * Tcl_EvalEx --
*
- * Given a pointer to a string that obeys the parsing conventions
- * for quoted things in Tcl, find the end of that quoted thing.
- * The actual thing may be a quoted argument or a parenthesized
- * index name.
+ * This procedure evaluates a Tcl script without using the compiler
+ * or byte-code interpreter. It just parses the script, creates
+ * values for each word of each command, then calls EvalObjv
+ * to execute each command.
*
* Results:
- * The return value is a pointer to the last character that is
- * part of the quoted string (i.e the character that's equal to
- * term). If the quoted string doesn't terminate properly then
- * the return value is a pointer to the null character at the
- * end of the string.
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR. A result or error message is left in
+ * interp's result.
*
* Side effects:
- * None.
+ * Depends on the script.
*
*----------------------------------------------------------------------
*/
-static char *
-QuoteEnd(string, lastChar, term)
- char *string; /* Pointer to character just after opening
- * "quote". */
- char *lastChar; /* Terminating character in string. */
- int term; /* This character will terminate the
- * quoted string (e.g. '"' or ')'). */
+int
+Tcl_EvalEx(interp, script, numBytes, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * script. Also used for error reporting. */
+ char *script; /* First character of script to evaluate. */
+ int numBytes; /* Number of bytes in script. If < 0, the
+ * script consists of all bytes up to the
+ * first null character. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
{
- register char *p = string;
- int count;
-
- while (*p != term) {
- if (*p == '\\') {
- (void) Tcl_Backslash(p, &count);
- p += count;
- } else if (*p == '[') {
- for (p++; *p != ']'; p++) {
- p = TclWordEnd(p, lastChar, 1, (int *) NULL);
- if (*p == 0) {
- return p;
+ Interp *iPtr = (Interp *) interp;
+ char *p, *next;
+ Tcl_Parse parse;
+#define NUM_STATIC_OBJS 20
+ Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
+ Tcl_Token *tokenPtr;
+ int i, code, commandLength, bytesLeft, nested;
+ CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
+ * in case TCL_EVAL_GLOBAL was set. */
+
+ /*
+ * The variables below keep track of how much state has been
+ * allocated while evaluating the script, so that it can be freed
+ * properly if an error occurs.
+ */
+
+ int gotParse = 0, objectsUsed = 0;
+
+ if (numBytes < 0) {
+ numBytes = strlen(script);
+ }
+ Tcl_ResetResult(interp);
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+
+ /*
+ * Each iteration through the following loop parses the next
+ * command from the script and then executes it.
+ */
+
+ objv = staticObjArray;
+ p = script;
+ bytesLeft = numBytes;
+ if (iPtr->evalFlags & TCL_BRACKET_TERM) {
+ nested = 1;
+ } else {
+ nested = 0;
+ }
+ iPtr->evalFlags = 0;
+ do {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto error;
+ }
+ gotParse = 1;
+ if (parse.numWords > 0) {
+ /*
+ * Generate an array of objects for the words of the command.
+ */
+
+ if (parse.numWords <= NUM_STATIC_OBJS) {
+ objv = staticObjArray;
+ } else {
+ objv = (Tcl_Obj **) ckalloc((unsigned)
+ (parse.numWords * sizeof (Tcl_Obj *)));
+ }
+ for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
+ objectsUsed < parse.numWords;
+ objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents);
+ if (objv[objectsUsed] == NULL) {
+ code = TCL_ERROR;
+ goto error;
}
}
- p++;
- } else if (*p == '$') {
- p = VarNameEnd(p, lastChar);
- if (*p == 0) {
- return p;
+
+ /*
+ * Execute the command and free the objects for its words.
+ */
+
+ code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
}
- p++;
- } else if (p == lastChar) {
- return p;
- } else {
- p++;
+ objectsUsed = 0;
+ if (objv != staticObjArray) {
+ ckfree((char *) objv);
+ objv = staticObjArray;
+ }
+ }
+
+ /*
+ * Advance to the next command in the script.
+ */
+
+ next = parse.commandStart + parse.commandSize;
+ bytesLeft -= next - p;
+ p = next;
+ Tcl_FreeParse(&parse);
+ gotParse = 0;
+ if ((nested != 0) && (p > script) && (p[-1] == ']')) {
+ /*
+ * We get here in the special case where the TCL_BRACKET_TERM
+ * flag was set in the interpreter and we reached a close
+ * bracket in the script. Return immediately.
+ */
+
+ iPtr->termOffset = (p - 1) - script;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return TCL_OK;
}
+ } while (bytesLeft > 0);
+ iPtr->termOffset = p - script;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return TCL_OK;
+
+ error:
+ /*
+ * Generate various pieces of error information, such as the line
+ * number where the error occurred and information to add to the
+ * errorInfo variable. Then free resources that had been allocated
+ * to the command.
+ */
+
+ if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ commandLength = parse.commandSize;
+ if ((parse.commandStart + commandLength) != (script + numBytes)) {
+ /*
+ * The command where the error occurred didn't end at the end
+ * of the script (i.e. it ended at a terminator character such
+ * as ";". Reduce the length by one so that the error message
+ * doesn't include the terminator character.
+ */
+
+ commandLength -= 1;
+ }
+ Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
+ }
+
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ if (gotParse) {
+ Tcl_FreeParse(&parse);
+ }
+ if (objv != staticObjArray) {
+ ckfree((char *) objv);
}
- return p-1;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * VarNameEnd --
+ * Tcl_Eval --
*
- * Given a pointer to a variable reference using $-notation, find
- * the end of the variable name spec.
+ * Execute a Tcl command in a string. This procedure executes the
+ * script directly, rather than compiling it to bytecodes. Before
+ * the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was
+ * the main procedure used for executing Tcl commands, but nowadays
+ * it isn't used much.
*
* Results:
- * The return value is a pointer to the last character that
- * is part of the variable name. If the variable name doesn't
- * terminate properly then the return value is a pointer to the
- * null character at the end of the string.
+ * The return value is one of the return codes defined in tcl.h
+ * (such as TCL_OK), and interp's result contains a value
+ * to supplement the return code. The value of the result
+ * will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
+ * you must copy it or lose it!
*
* Side effects:
- * None.
+ * Can be almost arbitrary, depending on the commands in the script.
*
*----------------------------------------------------------------------
*/
-static char *
-VarNameEnd(string, lastChar)
- char *string; /* Pointer to dollar-sign character. */
- char *lastChar; /* Terminating character in string. */
+int
+Tcl_Eval(interp, string)
+ Tcl_Interp *interp; /* Token for command interpreter (returned
+ * by previous call to Tcl_CreateInterp). */
+ char *string; /* Pointer to TCL command to execute. */
{
- register char *p = string+1;
+ int code;
- if (*p == '{') {
- for (p++; (*p != '}') && (p != lastChar); p++) {
- /* Empty loop body. */
- }
- return p;
- }
- while (isalnum(UCHAR(*p)) || (*p == '_')) {
- p++;
- }
- if ((*p == '(') && (p != string+1)) {
- return QuoteEnd(p+1, lastChar, ')');
- }
- return p-1;
+ code = Tcl_EvalEx(interp, string, -1, 0);
+
+ /*
+ * For backwards compatibility with old C code that predates the
+ * object system in Tcl 8.0, we have to mirror the object result
+ * back into the string result (some callers may expect it there).
+ */
+
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+ TCL_VOLATILE);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObj, Tcl_GlobalEvalObj --
+ *
+ * These functions are deprecated but we keep them around for backwards
+ * compatibility reasons.
+ *
+ * Results:
+ * See the functions they call.
+ *
+ * Side effects:
+ * See the functions they call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_EvalObj
+int
+Tcl_EvalObj(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return Tcl_EvalObjEx(interp, objPtr, 0);
}
+#undef Tcl_GlobalEvalObj
+int
+Tcl_GlobalEvalObj(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
+}
/*
*----------------------------------------------------------------------
*
- * ScriptEnd --
+ * Tcl_ParseVarName --
*
- * Given a pointer to the beginning of a Tcl script, find the end of
- * the script.
+ * Given a string starting with a $ sign, parse off a variable
+ * name and return information about the parse.
*
* Results:
- * The return value is a pointer to the last character that's part
- * of the script pointed to by "p". If the command doesn't end
- * properly within the string then the return value is the address
- * of the null character at the end of the string.
+ * The return value is TCL_OK if the command was parsed
+ * successfully and TCL_ERROR otherwise. If an error occurs and
+ * interp isn't NULL then an error message is left in its result.
+ * On a successful return, tokenPtr and numTokens fields of
+ * parsePtr are filled in with information about the variable name
+ * that was parsed. The "size" field of the first new token gives
+ * the total number of bytes in the variable name. Other fields in
+ * parsePtr are undefined.
*
* Side effects:
- * None.
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
*
*----------------------------------------------------------------------
*/
-static char *
-ScriptEnd(p, lastChar, nested)
- char *p; /* Script to check. */
- char *lastChar; /* Terminating character in string. */
- int nested; /* Zero means this is a top-level command.
- * One means this is a nested command (the
- * last character of the script must be
- * an unquoted ]). */
+int
+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
+ * character must be "$". */
+ 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
+ * about the variable name. */
+ int append; /* Non-zero means append tokens to existing
+ * information in parsePtr; zero means ignore
+ * existing tokens in parsePtr and reinitialize
+ * it. */
{
- int commentOK = 1;
- int length;
+ Tcl_Token *tokenPtr;
+ char *end, *src;
+ unsigned char c;
+ int varIndex, offset;
+ Tcl_UniChar ch;
- while (1) {
- while (isspace(UCHAR(*p))) {
- if (*p == '\n') {
- commentOK = 1;
- }
- p++;
- }
- if ((*p == '#') && commentOK) {
- do {
- if (*p == '\\') {
- /*
- * If the script ends with backslash-newline, then
- * this command isn't complete.
- */
-
- if ((p[1] == '\n') && (p+2 == lastChar)) {
- return p+2;
- }
- Tcl_Backslash(p, &length);
- p += length;
- } else {
- p++;
+ if (numBytes >= 0) {
+ end = string + numBytes;
+ } else {
+ end = string + 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->interp = interp;
+ parsePtr->incomplete = 0;
+ }
+
+ /*
+ * Generate one token for the variable, an additional token for the
+ * name, plus any number of additional tokens for the index, if
+ * there is one.
+ */
+
+ src = string;
+ if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_VARIABLE;
+ tokenPtr->start = src;
+ varIndex = parsePtr->numTokens;
+ parsePtr->numTokens++;
+ tokenPtr++;
+ src++;
+ if (src >= end) {
+ goto justADollarSign;
+ }
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+
+ /*
+ * The name of the variable can have three forms:
+ * 1. The $ sign is followed by an open curly brace. Then
+ * the variable name is everything up to the next close
+ * curly brace, and the variable is a scalar variable.
+ * 2. The $ sign is not followed by an open curly brace. Then
+ * the variable name is everything up to the next
+ * character that isn't a letter, digit, or underscore.
+ * :: sequences are also considered part of the variable
+ * name, in order to support namespaces. If the following
+ * character is an open parenthesis, then the information
+ * between parentheses is the array element name.
+ * 3. The $ sign is followed by something that isn't a letter,
+ * digit, or underscore: in this case, there is no variable
+ * name and the token is just "$".
+ */
+
+ if (*src == '{') {
+ src++;
+ 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",
+ TCL_STATIC);
}
- } while ((p != lastChar) && (*p != '\n'));
- continue;
+ parsePtr->term = tokenPtr->start-1;
+ parsePtr->incomplete = 1;
+ goto error;
+ }
+ if (*src == '}') {
+ break;
+ }
+ src++;
}
- p = TclWordEnd(p, lastChar, nested, &commentOK);
- if (p == lastChar) {
- return p;
+ tokenPtr->size = src - tokenPtr->start;
+ tokenPtr[-1].size = src - tokenPtr[-1].start;
+ parsePtr->numTokens++;
+ src++;
+ } else {
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ while (src != end) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ c = UCHAR(ch);
+ if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
+ src += offset;
+ continue;
+ }
+ if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
+ src += 2;
+ while ((src != end) && (*src == ':')) {
+ src += 1;
+ }
+ continue;
+ }
+ break;
}
- p++;
- if (nested) {
- if (*p == ']') {
- return p;
+ tokenPtr->size = src - tokenPtr->start;
+ if (tokenPtr->size == 0) {
+ goto justADollarSign;
+ }
+ parsePtr->numTokens++;
+ if ((src != end) && (*src == '(')) {
+ /*
+ * This is a reference to an array element. Call
+ * ParseTokens recursively to parse the element name,
+ * since it could contain any number of substitutions.
+ */
+
+ if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
+ != TCL_OK) {
+ goto error;
}
- } else {
- if (p == lastChar) {
- return p-1;
+ if ((parsePtr->term == end) || (*parsePtr->term != ')')) {
+ if (parsePtr->interp != NULL) {
+ Tcl_SetResult(parsePtr->interp, "missing )",
+ TCL_STATIC);
+ }
+ parsePtr->term = src;
+ parsePtr->incomplete = 1;
+ goto error;
}
+ src = parsePtr->term + 1;
}
}
+ tokenPtr = &parsePtr->tokenPtr[varIndex];
+ tokenPtr->size = src - tokenPtr->start;
+ tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
+ return TCL_OK;
+
+ /*
+ * The dollar sign isn't followed by a variable name.
+ * replace the TCL_TOKEN_VARIABLE token with a
+ * TCL_TOKEN_TEXT token for the dollar sign.
+ */
+
+ justADollarSign:
+ tokenPtr = &parsePtr->tokenPtr[varIndex];
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = 1;
+ tokenPtr->numComponents = 0;
+ return TCL_OK;
+
+ error:
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ return TCL_ERROR;
}
/*
@@ -738,7 +1755,7 @@ ScriptEnd(p, lastChar, nested)
* *termPtr gets filled in with the address of the character
* just after the last one in the variable specifier. If the
* variable doesn't exist, then the return value is NULL and
- * an error message will be left in interp->result.
+ * an error message will be left in interp's result.
*
* Side effects:
* None.
@@ -756,120 +1773,347 @@ Tcl_ParseVar(interp, string, termPtr)
* one in the variable specifier. */
{
- char *name1, *name1End, c, *result;
- register char *name2;
-#define NUM_CHARS 200
- char copyStorage[NUM_CHARS];
- ParseValue pv;
+ Tcl_Parse parse;
+ register Tcl_Obj *objPtr;
+
+ if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
+ return NULL;
+ }
+
+ if (termPtr != NULL) {
+ *termPtr = string + parse.tokenPtr->size;
+ }
+ if (parse.numTokens == 1) {
+ /*
+ * There isn't a variable name after all: the $ is just a $.
+ */
+
+ return "$";
+ }
+
+ objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens);
+ if (objPtr == NULL) {
+ return NULL;
+ }
/*
- * There are three cases:
- * 1. The $ sign is followed by an open curly brace. Then the variable
- * name is everything up to the next close curly brace, and the
- * variable is a scalar variable.
- * 2. The $ sign is not followed by an open curly brace. Then the
- * variable name is everything up to the next character that isn't
- * a letter, digit, or underscore, or a "::" namespace separator.
- * If the following character is an open parenthesis, then the
- * information between parentheses is the array element name, which
- * can include any of the substitutions permissible between quotes.
- * 3. The $ sign is followed by something that isn't a letter, digit,
- * underscore, or a "::" namespace separator: in this case,
- * there is no variable name, and "$" is returned.
+ * At this point we should have an object containing the value of
+ * a variable. Just return the string from that object.
*/
- name2 = NULL;
- string++;
- if (*string == '{') {
- string++;
- name1 = string;
- while (*string != '}') {
- if (*string == 0) {
- Tcl_SetResult(interp, "missing close-brace for variable name",
- TCL_STATIC);
- if (termPtr != 0) {
- *termPtr = string;
- }
- return NULL;
- }
- string++;
- }
- name1End = string;
- string++;
+#ifdef TCL_COMPILE_DEBUG
+ if (objPtr->refCount < 2) {
+ panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens");
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ TclDecrRefCount(objPtr);
+ return TclGetString(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseBraces --
+ *
+ * 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.
+ *
+ * Results:
+ * The return value is TCL_OK if the string was parsed successfully and
+ * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
+ * an error message is left in its result. On a successful return,
+ * tokenPtr and numTokens fields of parsePtr are filled in with
+ * information about the string that was parsed. Other fields in
+ * parsePtr are undefined. termPtr is set to point to the character
+ * just after the last one in the braced string.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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.
+ * The first character must be '{'. */
+ 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;
+ /* Structure to fill in with information
+ * about the string. */
+ int append; /* Non-zero means append tokens to existing
+ * information in parsePtr; zero means
+ * ignore existing tokens in parsePtr and
+ * reinitialize it. */
+ 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;
+ int startIndex, level, length;
+
+ if ((numBytes >= 0) || (string == NULL)) {
+ end = string + numBytes;
} else {
- name1 = string;
- while (isalnum(UCHAR(*string)) || (*string == '_')
- || (*string == ':')) {
- if (*string == ':') {
- if (*(string+1) == ':') {
- string += 2; /* skip over the initial :: */
- while (*string == ':') {
- string++; /* skip over a subsequent : */
- }
- } else {
- break; /* : by itself */
- }
+ end = string + 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->interp = interp;
+ }
+
+ src = string+1;
+ startIndex = parsePtr->numTokens;
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[startIndex];
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ level = 1;
+ while (1) {
+ while (CHAR_TYPE(*src) == TYPE_NORMAL) {
+ src++;
+ }
+ if (*src == '}') {
+ level--;
+ if (level == 0) {
+ 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 {
- string++;
+ src += length;
}
- }
- if (string == name1) {
- if (termPtr != 0) {
- *termPtr = string;
+ } else if (src == end) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
}
- return "$";
+ parsePtr->term = string;
+ parsePtr->incomplete = 1;
+ goto error;
+ } else {
+ src++;
}
- name1End = string;
- if (*string == '(') {
- char *end;
+ }
- /*
- * Perform substitutions on the array element name, just as
- * is done for quotes.
- */
+ /*
+ * 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;
+ }
+ return TCL_OK;
- pv.buffer = pv.next = copyStorage;
- pv.end = copyStorage + NUM_CHARS - 1;
- pv.expandProc = TclExpandParseValue;
- pv.clientData = (ClientData) NULL;
- if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
- != TCL_OK) {
- char msg[200];
- int length;
+ error:
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseQuotedString --
+ *
+ * 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.
+ *
+ * Results:
+ * The return value is TCL_OK if the string was parsed successfully and
+ * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
+ * an error message is left in its result. On a successful return,
+ * tokenPtr and numTokens fields of parsePtr are filled in with
+ * information about the string that was parsed. Other fields in
+ * parsePtr are undefined. termPtr is set to point to the character
+ * just after the quoted string's terminating close-quote.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
- length = string-name1;
- if (length > 100) {
- length = 100;
- }
- sprintf(msg, "\n (parsing index for array \"%.*s\")",
- length, name1);
- Tcl_AddErrorInfo(interp, msg);
- result = NULL;
- name2 = pv.buffer;
- if (termPtr != 0) {
- *termPtr = end;
- }
- goto done;
- }
- Tcl_ResetResult(interp);
- string = end;
- name2 = pv.buffer;
+int
+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.
+ * The first character must be '"'. */
+ 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;
+ /* Structure to fill in with information
+ * about the string. */
+ int append; /* Non-zero means append tokens to existing
+ * information in parsePtr; zero means
+ * ignore existing tokens in parsePtr and
+ * reinitialize it. */
+ 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 (!append) {
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = end;
+ parsePtr->interp = interp;
+ }
+
+ if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+ goto error;
+ }
+ if (*parsePtr->term != '"') {
+ if (interp != NULL) {
+ Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
}
+ parsePtr->term = string;
+ parsePtr->incomplete = 1;
+ goto error;
}
- if (termPtr != 0) {
- *termPtr = string;
+ if (termPtr != NULL) {
+ *termPtr = (parsePtr->term + 1);
}
+ return TCL_OK;
- c = *name1End;
- *name1End = 0;
- result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
- *name1End = c;
+ error:
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommandComplete --
+ *
+ * This procedure is shared by TclCommandComplete and
+ * Tcl_ObjCommandcoComplete; it does all the real work of seeing
+ * whether a script is complete
+ *
+ * Results:
+ * 1 is returned if the script is complete, 0 if there are open
+ * delimiters such as " or (. 1 is also returned if there is a
+ * parse error in the script other than unmatched delimiters.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- done:
- if ((name2 != NULL) && (pv.buffer != copyStorage)) {
- ckfree(pv.buffer);
+static int
+CommandComplete(script, length)
+ char *script; /* Script to check. */
+ int length; /* Number of bytes in script. */
+{
+ Tcl_Parse parse;
+ char *p, *end;
+
+ p = script;
+ end = p + length;
+ while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
+ == TCL_OK) {
+ p = parse.commandStart + parse.commandSize;
+ if (*p == 0) {
+ break;
+ }
+ }
+ if (parse.incomplete) {
+ return 0;
}
- return result;
+ return 1;
}
/*
@@ -877,12 +2121,14 @@ Tcl_ParseVar(interp, string, termPtr)
*
* Tcl_CommandComplete --
*
- * Given a partial or complete Tcl command, this procedure
- * determines whether the command is complete in the sense
+ * Given a partial or complete Tcl script, this procedure
+ * determines whether the script is complete in the sense
* of having matched braces and quotes and brackets.
*
* Results:
- * 1 is returned if the command is complete, 0 otherwise.
+ * 1 is returned if the script is complete, 0 otherwise.
+ * 1 is also returned if there is a parse error in the script
+ * other than unmatched delimiters.
*
* Side effects:
* None.
@@ -891,16 +2137,10 @@ Tcl_ParseVar(interp, string, termPtr)
*/
int
-Tcl_CommandComplete(cmd)
- char *cmd; /* Command to check. */
+Tcl_CommandComplete(script)
+ char *script; /* Script to check. */
{
- char *p;
-
- if (*cmd == 0) {
- return 1;
- }
- p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
- return (*p != 0);
+ return CommandComplete(script, (int) strlen(script));
}
/*
@@ -922,17 +2162,63 @@ Tcl_CommandComplete(cmd)
*/
int
-TclObjCommandComplete(cmdPtr)
- Tcl_Obj *cmdPtr; /* Points to object holding command
+TclObjCommandComplete(objPtr)
+ Tcl_Obj *objPtr; /* Points to object holding script
* to check. */
{
- char *cmd, *p;
+ char *script;
int length;
- cmd = Tcl_GetStringFromObj(cmdPtr, &length);
- if (length == 0) {
- return 1;
+ script = Tcl_GetStringFromObj(objPtr, &length);
+ return CommandComplete(script, length);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIsLocalScalar --
+ *
+ * Check to see if a given string is a legal scalar variable
+ * name with no namespace qualifiers or substitutions.
+ *
+ * Results:
+ * Returns 1 if the variable is a local scalar.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsLocalScalar(src, len)
+ CONST char *src;
+ int len;
+{
+ CONST char *p;
+ CONST char *lastChar = src + (len - 1);
+
+ for (p = src; p <= lastChar; p++) {
+ if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
+ (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
+ /*
+ * TCL_COMMAND_END is returned for the last character
+ * of the string. By this point we know it isn't
+ * an array or namespace reference.
+ */
+
+ return 0;
+ }
+ if (*p == '(') {
+ if (*lastChar == ')') { /* we have an array element */
+ return 0;
+ }
+ } else if (*p == ':') {
+ if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
+ return 0;
+ }
+ }
}
- p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
- return (*p != 0);
+
+ return 1;
}