diff options
Diffstat (limited to 'generic/tclParse.c')
| -rw-r--r-- | generic/tclParse.c | 575 |
1 files changed, 288 insertions, 287 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c index eb60d8d..b40b636 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,9 +12,8 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ - + #include "tclInt.h" -#include "tclParse.h" /* * The following table provides parsing information about each possible 8-bit @@ -42,7 +41,18 @@ * TYPE_BRACE - Character is a curly brace (either left or right). */ -const char charTypeTable[] = { +#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) (charTypeTable+128)[(int)(c)] + +static const char charTypeTable[] = { /* * Negative character values, from -128 to -1: */ @@ -160,11 +170,11 @@ const char charTypeTable[] = { */ static inline int CommandComplete(const char *script, int numBytes); -static size_t ParseComment(const char *src, size_t numBytes, +static int ParseComment(const char *src, int numBytes, Tcl_Parse *parsePtr); -static int ParseTokens(const char *src, size_t numBytes, int mask, +static int ParseTokens(const char *src, int numBytes, int mask, int flags, Tcl_Parse *parsePtr); -static size_t ParseWhiteSpace(const char *src, size_t numBytes, +static int ParseWhiteSpace(const char *src, int numBytes, int *incompletePtr, char *typePtr); /* @@ -172,13 +182,13 @@ static size_t ParseWhiteSpace(const char *src, size_t numBytes, * * TclParseInit -- * - * Initialize the fields of a Tcl_Parse struct. + * Initialize the fields of a Tcl_Parse struct. * * Results: - * None. + * None. * * Side effects: - * The Tcl_Parse struct pointed to by parsePtr gets initialized. + * The Tcl_Parse struct pointed to by parsePtr gets initialized. * *---------------------------------------------------------------------- */ @@ -187,14 +197,11 @@ void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ const char *start, /* Start of string to be parsed. */ - size_t numBytes, /* Total number of bytes in string. If - * TCL_STRLEN, the script consists of all - * bytes up to the first null character. */ + int numBytes, /* Total number of bytes in string. If < 0, + * the script consists of all bytes up to the + * first null character. */ Tcl_Parse *parsePtr) /* Points to struct to initialize */ { - if (numBytes == TCL_STRLEN) { - numBytes = strlen(start); - } parsePtr->numWords = 0; parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; @@ -236,15 +243,15 @@ Tcl_ParseCommand( * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ - register size_t numBytes, /* Total number of bytes in string. If - * TCL_STRLEN, the script consists of all - * bytes up to the first null character. */ + 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: * 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 + /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { @@ -261,12 +268,11 @@ Tcl_ParseCommand( if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't parse a NULL pointer", TCL_STRLEN)); + Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); } return TCL_ERROR; } - if (numBytes == TCL_STRLEN) { + if (numBytes < 0) { numBytes = strlen(start); } TclParseInit(interp, start, numBytes, parsePtr); @@ -449,7 +455,7 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { - size_t size; + int size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); @@ -490,10 +496,9 @@ Tcl_ParseCommand( * tokens representing the expanded list. */ - const char *listStart; + CONST char *listStart; int growthNeeded = wordIndex + 2*elemCount - parsePtr->numTokens; - parsePtr->numWords += elemCount - 1; if (growthNeeded > 0) { TclGrowParseTokenArray(parsePtr, growthNeeded); @@ -513,7 +518,7 @@ Tcl_ParseCommand( listStart = nextElem = tokenPtr[1].start; while (nextElem < listEnd) { int quoted; - + tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; tokenPtr->numComponents = 1; @@ -572,14 +577,14 @@ Tcl_ParseCommand( } if (src[-1] == '"') { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-quote", TCL_STRLEN)); + Tcl_SetResult(interp, "extra characters after close-quote", + TCL_STATIC); } parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-brace", TCL_STRLEN)); + Tcl_SetResult(interp, "extra characters after close-brace", + TCL_STATIC); } parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; } @@ -623,6 +628,47 @@ TclIsSpaceProc( /* *---------------------------------------------------------------------- * + * TclIsBareword-- + * + * Report whether byte is one that can be part of a "bareword". + * This concept is named in expression parsing, where it determines + * what can be a legal function name, but is the same definition used + * in determining what variable names can be parsed as variable + * substitutions without the benefit of enclosing braces. The set of + * ASCII chars that are accepted are the numeric chars ('0'-'9'), + * the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_'). + * + * Results: + * Returns 1, if byte is in the accepted set of chars, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclIsBareword( + char byte) +{ + if (byte < '0' || byte > 'z') { + return 0; + } + if (byte <= '9' || byte >= 'a') { + return 1; + } + if (byte == '_') { + return 1; + } + if (byte < 'A' || byte > 'Z') { + return 0; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * * ParseWhiteSpace -- * * Scans up to numBytes bytes starting at src, consuming white space @@ -640,10 +686,10 @@ TclIsSpaceProc( *---------------------------------------------------------------------- */ -static size_t +static int ParseWhiteSpace( const char *src, /* First character to parse. */ - register size_t numBytes, /* Max number of bytes to scan. */ + register int numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type @@ -667,7 +713,7 @@ ParseWhiteSpace( if (p[1] != '\n') { break; } - p += 2; + p+=2; if (--numBytes == 0) { *incompletePtr = 1; break; @@ -694,32 +740,22 @@ ParseWhiteSpace( *---------------------------------------------------------------------- */ -size_t +int TclParseAllWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes) /* Max number of byes to scan */ + int numBytes) /* Max number of byes to scan */ { int dummy; char type; const char *p = src; - if (numBytes == TCL_STRLEN) { - while (1) { - p += ParseWhiteSpace(p, TCL_STRLEN, &dummy, &type); - if (*p != '\n') { - break; - } - p++; - } - } else { - do { - int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type); + do { + int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type); - p += scanned; - numBytes -= scanned; - } while (numBytes && (*p == '\n') && (p++, --numBytes)); - } - return p - src; + p += scanned; + numBytes -= scanned; + } while (numBytes && (*p == '\n') && (p++, --numBytes)); + return (p-src); } /* @@ -744,25 +780,25 @@ TclParseAllWhiteSpace( *---------------------------------------------------------------------- */ -size_t +int TclParseHex( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of byes to scan */ - int *resultPtr) /* Points to storage provided by caller where - * the character resulting from the + 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. */ { - int result = 0; + Tcl_UniChar result = 0; register const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); - if (!isxdigit(digit) || (result > 0x10fff)) { + if (!isxdigit(digit)) { break; } - p++; + ++p; result <<= 4; if (digit >= 'a') { @@ -787,24 +823,24 @@ TclParseHex( * 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. + * 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. + * None. * *---------------------------------------------------------------------- */ -size_t +int TclParseBackslash( const char *src, /* Points to the backslash character of a a * backslash sequence. */ - size_t numBytes, /* Max number of bytes to scan. */ - size_t *readPtr, /* NULL, or points to storage where the number + 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 @@ -812,8 +848,7 @@ TclParseBackslash( * written there. */ { register const char *p = src+1; - Tcl_UniChar unichar; - int result; + Tcl_UniChar result; int count; char buf[TCL_UTF_MAX]; @@ -870,7 +905,7 @@ TclParseBackslash( result = 0xb; break; case 'x': - count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result); + count += TclParseHex(p+1, numBytes-2, &result); if (count == 2) { /* * No hexadigits -> This is just "x". @@ -893,15 +928,6 @@ TclParseBackslash( result = 'u'; } break; - case 'U': - count += TclParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result); - if (count == 2) { - /* - * No hexadigits -> This is just "U". - */ - result = 'U'; - } - break; case '\n': count--; do { @@ -920,21 +946,21 @@ TclParseBackslash( */ if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ - result = *p - '0'; + result = (unsigned char)(*p - '0'); p++; if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */ || (UCHAR(*p) >= '8')) { break; } count = 3; - result = (result << 3) + (*p - '0'); + result = (unsigned char)((result << 3) + (*p - '0')); p++; if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */ - || (UCHAR(*p) >= '8') || (result >= 0x20)) { + || (UCHAR(*p) >= '8')) { break; } count = 4; - result = UCHAR((result << 3) + (*p - '0')); + result = (unsigned char)((result << 3) + (*p - '0')); break; } @@ -946,15 +972,14 @@ TclParseBackslash( */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { - count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ + 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, &unichar) + 1; + count = Tcl_UtfToUniChar(utfBytes, &result) + 1; } - result = unichar; break; } @@ -962,7 +987,7 @@ TclParseBackslash( if (readPtr != NULL) { *readPtr = count; } - return Tcl_UniCharToUtf(result, dst); + return Tcl_UniCharToUtf((int) result, dst); } /* @@ -974,19 +999,19 @@ TclParseBackslash( * defined by Tcl's parsing rules. * * Results: - * Records in parsePtr information about the parse. Returns the number of - * bytes consumed. + * Records in parsePtr information about the parse. Returns the number of + * bytes consumed. * * Side effects: - * None. + * None. * *---------------------------------------------------------------------- */ -static size_t +static int ParseComment( const char *src, /* First character to parse. */ - register size_t numBytes, /* Max number of bytes to scan. */ + register int numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ @@ -995,7 +1020,7 @@ ParseComment( while (numBytes) { char type; - size_t scanned; + int scanned; do { scanned = ParseWhiteSpace(p, numBytes, @@ -1071,7 +1096,7 @@ ParseComment( static int ParseTokens( register const char *src, /* First character to parse. */ - register size_t numBytes, /* Max number of bytes to scan. */ + 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 any of the bits in @@ -1131,7 +1156,7 @@ ParseTokens( } /* - * This is a variable reference. Call Tcl_ParseVarName to do all + * This is a variable reference. Call Tcl_ParseVarName to do all * the dirty work of parsing the name. */ @@ -1155,14 +1180,15 @@ ParseTokens( } /* - * Command substitution. Call Tcl_ParseCommand recursively (and + * Command substitution. Call Tcl_ParseCommand recursively (and * repeatedly) to parse the nested command(s), then throw away the * parse information. */ src++; numBytes--; - nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); + nestedPtr = (Tcl_Parse *) + TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); while (1) { if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, nestedPtr) != TCL_OK) { @@ -1189,8 +1215,8 @@ ParseTokens( } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-bracket", TCL_STRLEN)); + Tcl_SetResult(parsePtr->interp, + "missing close-bracket", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; @@ -1308,7 +1334,7 @@ Tcl_FreeParse( * call to Tcl_ParseCommand. */ { if (parsePtr->tokenPtr != parsePtr->staticTokens) { - ckfree(parsePtr->tokenPtr); + ckfree((char *) parsePtr->tokenPtr); parsePtr->tokenPtr = parsePtr->staticTokens; } } @@ -1346,9 +1372,9 @@ Tcl_ParseVarName( * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ - register size_t numBytes, /* Total number of bytes in string. If - * TCL_STRLEN, the string consists of all - * bytes up to the first null character. */ + 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 about * the variable name. */ int append) /* Non-zero means append tokens to existing @@ -1358,15 +1384,13 @@ Tcl_ParseVarName( { Tcl_Token *tokenPtr; register const char *src; - unsigned char c; - int varIndex, offset; - Tcl_UniChar ch; + int varIndex; unsigned array; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes == TCL_STRLEN) { + if (numBytes < 0) { numBytes = strlen(start); } @@ -1425,8 +1449,8 @@ Tcl_ParseVarName( } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace for variable name", TCL_STRLEN)); + Tcl_SetResult(parsePtr->interp, + "missing close-brace for variable name", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; parsePtr->term = tokenPtr->start-1; @@ -1443,22 +1467,12 @@ Tcl_ParseVarName( tokenPtr->numComponents = 0; 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; - numBytes -= offset; + if (TclIsBareword(*src)) { + src += 1; + numBytes -= 1; continue; } - if ((c == ':') && (numBytes != 1) && (src[1] == ':')) { + if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) { src += 2; numBytes -= 2; while (numBytes && (*src == ':')) { @@ -1493,8 +1507,8 @@ Tcl_ParseVarName( } if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing )", TCL_STRLEN)); + Tcl_SetResult(parsePtr->interp, "missing )", + TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_PAREN; parsePtr->term = src; @@ -1559,9 +1573,10 @@ Tcl_ParseVar( { register Tcl_Obj *objPtr; int code; - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); - if (Tcl_ParseVarName(interp, start, TCL_STRLEN, parsePtr, 0) != TCL_OK) { + if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); return NULL; } @@ -1580,6 +1595,7 @@ Tcl_ParseVar( code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1, NULL, NULL); + Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; @@ -1638,11 +1654,11 @@ Tcl_ParseBraces( * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ - register size_t numBytes, /* Total number of bytes in string. If - * TCL_STRLEN, the string consists of all - * bytes up to the first null character. */ + 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, - /* Structure to fill in with information about + /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore @@ -1655,13 +1671,12 @@ Tcl_ParseBraces( { Tcl_Token *tokenPtr; register const char *src; - int startIndex, level; - size_t length; + int startIndex, level, length; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes == TCL_STRLEN) { + if (numBytes < 0) { numBytes = strlen(start); } @@ -1770,8 +1785,7 @@ Tcl_ParseBraces( goto error; } - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace", TCL_STRLEN)); + Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC); /* * Guess if the problem is due to comments by searching the source string @@ -1793,9 +1807,8 @@ Tcl_ParseBraces( break; case '#' : if (openBrace && TclIsSpaceProc(src[-1])) { - Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp), - ": possible unbalanced brace in comment", - TCL_STRLEN); + Tcl_AppendResult(parsePtr->interp, + ": possible unbalanced brace in comment", NULL); goto error; } break; @@ -1842,11 +1855,11 @@ Tcl_ParseQuotedString( * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ - register size_t numBytes, /* Total number of bytes in string. If - * TCL_STRLEN, the string consists of all - * bytes up to the first null character. */ + 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, - /* Structure to fill in with information about + /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore @@ -1860,7 +1873,7 @@ Tcl_ParseQuotedString( if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes == TCL_STRLEN) { + if (numBytes < 0) { numBytes = strlen(start); } @@ -1874,8 +1887,7 @@ Tcl_ParseQuotedString( } if (*parsePtr->term != '"') { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing \"", TCL_STRLEN)); + Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; parsePtr->term = start; @@ -1895,42 +1907,33 @@ Tcl_ParseQuotedString( /* *---------------------------------------------------------------------- * - * TclSubstParse -- + * Tcl_SubstObj -- + * + * This function performs the substitutions specified on the given string + * as described in the user documentation for the "subst" Tcl command. * - * Token parser used by the [subst] command. Parses the string made up of - * 'numBytes' bytes starting at 'bytes'. Parsing is controlled by the - * flags argument to provide support for the -nobackslashes, -nocommands, - * and -novariables options, as represented by the flag values - * TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES. - * * Results: - * None. + * A Tcl_Obj* containing the substituted string, or NULL to indicate that + * an error occurred. * * Side effects: - * The Tcl_Parse struct '*parsePtr' is filled with parse results. - * The caller is expected to eventually call Tcl_FreeParse() to properly - * cleanup the value written there. - * - * If a parse error occurs, the Tcl_InterpState value '*statePtr' is - * filled with the state created by that error. When *statePtr is written - * to, the caller is expected to make the required calls to either - * Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the - * value written there. + * See the user documentation. * *---------------------------------------------------------------------- */ -void -TclSubstParse( - Tcl_Interp *interp, - const char *bytes, - size_t numBytes, - int flags, - Tcl_Parse *parsePtr, - Tcl_InterpState *statePtr) +Tcl_Obj * +Tcl_SubstObj( + Tcl_Interp *interp, /* Interpreter in which substitution occurs */ + Tcl_Obj *objPtr, /* The value to be substituted. */ + int flags) /* What substitutions to do. */ { - size_t length = numBytes; - const char *p = bytes; + int length, tokensLeft, code; + Tcl_Token *endTokenPtr; + Tcl_Obj *result, *errMsg = NULL; + const char *p = TclGetStringFromObj(objPtr, &length); + Tcl_Parse *parsePtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); TclParseInit(interp, p, length, parsePtr); @@ -1942,11 +1945,12 @@ TclSubstParse( if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) { /* - * There was a parse error. Save the interpreter state for possible - * error reporting later. + * There was a parse error. Save the error message for possible + * reporting later. */ - *statePtr = Tcl_SaveInterpState(interp, TCL_ERROR); + errMsg = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(errMsg); /* * We need to re-parse to get the portion of the string we can [subst] @@ -2012,10 +2016,10 @@ TclSubstParse( parsePtr->tokenPtr + parsePtr->numTokens - 2; if (varTokenPtr->type != TCL_TOKEN_VARIABLE) { - Tcl_Panic("TclSubstParse: programming error"); + Tcl_Panic("Tcl_SubstObj: programming error"); } if (varTokenPtr[1].type != TCL_TOKEN_TEXT) { - Tcl_Panic("TclSubstParse: programming error"); + Tcl_Panic("Tcl_SubstObj: programming error"); } parsePtr->numTokens -= 2; } @@ -2044,7 +2048,7 @@ TclSubstParse( Tcl_Token *tokenPtr; const char *lastTerm = parsePtr->term; - Tcl_Parse *nestedPtr = + Tcl_Parse *nestedPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); while (TCL_OK == @@ -2089,8 +2093,63 @@ TclSubstParse( break; default: - Tcl_Panic("bad parse in TclSubstParse: %c", p[length]); + Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]); + } + } + + /* + * Next, substitute the parsed tokens just as in normal Tcl evaluation. + */ + + endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; + tokensLeft = parsePtr->numTokens; + code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, + &tokensLeft, 1, NULL, NULL); + if (code == TCL_OK) { + Tcl_FreeParse(parsePtr); + TclStackFree(interp, parsePtr); + if (errMsg != NULL) { + Tcl_SetObjResult(interp, errMsg); + Tcl_DecrRefCount(errMsg); + return NULL; + } + return Tcl_GetObjResult(interp); + } + + result = Tcl_NewObj(); + while (1) { + switch (code) { + case TCL_ERROR: + Tcl_FreeParse(parsePtr); + TclStackFree(interp, parsePtr); + Tcl_DecrRefCount(result); + if (errMsg != NULL) { + Tcl_DecrRefCount(errMsg); + } + return NULL; + case TCL_BREAK: + tokensLeft = 0; /* Halt substitution */ + default: + Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp)); + } + + if (tokensLeft == 0) { + Tcl_FreeParse(parsePtr); + TclStackFree(interp, parsePtr); + if (errMsg != NULL) { + if (code != TCL_BREAK) { + Tcl_DecrRefCount(result); + Tcl_SetObjResult(interp, errMsg); + Tcl_DecrRefCount(errMsg); + return NULL; + } + Tcl_DecrRefCount(errMsg); + } + return result; } + + code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, + &tokensLeft, 1, NULL, NULL); } } @@ -2105,13 +2164,13 @@ TclSubstParse( * non-TCL_OK completion code arises. * * Results: - * The return value is a standard Tcl completion code. The result in - * interp is the substituted value, or an error message if TCL_ERROR is - * returned. If tokensLeftPtr is not NULL, then it points to an int where - * the number of tokens remaining to be processed is written. + * The return value is a standard Tcl completion code. The result in + * interp is the substituted value, or an error message if TCL_ERROR is + * returned. If tokensLeftPtr is not NULL, then it points to an int where + * the number of tokens remaining to be processed is written. * * Side effects: - * Can be anything, depending on the types of substitution done. + * Can be anything, depending on the types of substitution done. * *---------------------------------------------------------------------- */ @@ -2123,36 +2182,35 @@ TclSubstTokens( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - size_t count, /* Number of tokens to consider at tokenPtr. + int count, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ - size_t *tokensLeftPtr, /* If not NULL, points to memory where an + int *tokensLeftPtr, /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ int line, /* The line the script starts on. */ - ssize_t *clNextOuter, /* Information about an outer context for */ - const char *outerScript) /* continuation line data. This is set by - * EvalEx() to properly handle [...]-nested - * commands. The 'outerScript' refers to the - * most-outer script containing the embedded - * command, which is refered to by 'script'. - * The 'clNextOuter' refers to the current - * entry in the table of continuation lines in - * this "master script", and the character - * offsets are relative to the 'outerScript' - * as well. - * - * If outerScript == script, then this call is - * for words in the outer-most script or - * command. See Tcl_EvalEx and TclEvalObjEx - * for the places generating arguments for - * which this is true. */ + int* clNextOuter, /* Information about an outer context for */ + CONST char* outerScript) /* continuation line data. This is set by + * EvalEx() to properly handle [...]-nested + * commands. The 'outerScript' refers to the + * most-outer script containing the embedded + * command, which is refered to by 'script'. The + * 'clNextOuter' refers to the current entry in + * the table of continuation lines in this + * "master script", and the character offsets are + * relative to the 'outerScript' as well. + * + * If outerScript == script, then this call is for + * words in the outer-most script/command. See + * Tcl_EvalEx() and TclEvalObjEx() for the places + * generating arguments for which this is true. + */ { Tcl_Obj *result; int code = TCL_OK; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL, i, adjust; - ssize_t *clPosition = NULL; - Interp *iPtr = (Interp *) interp; + int* clPosition = NULL; + Interp* iPtr = (Interp*) interp; int inFile = iPtr->evalFlags & TCL_EVAL_FILE; /* @@ -2169,24 +2227,24 @@ TclSubstTokens( * For the handling of continuation lines in literals we first check if * this is actually a literal. For if not we can forego the additional * processing. Otherwise we pre-allocate a small table to store the - * locations of all continuation lines we find in this literal, if any. - * The table is extended if needed. + * locations of all continuation lines we find in this literal, if + * any. The table is extended if needed. */ - numCL = 0; - maxNumCL = 0; + numCL = 0; + maxNumCL = 0; isLiteral = 1; for (i=0 ; i < count; i++) { - if ((tokenPtr[i].type != TCL_TOKEN_TEXT) - && (tokenPtr[i].type != TCL_TOKEN_BS)) { + if ((tokenPtr[i].type != TCL_TOKEN_TEXT) && + (tokenPtr[i].type != TCL_TOKEN_BS)) { isLiteral = 0; break; } } if (isLiteral) { - maxNumCL = NUM_STATIC_POS; - clPosition = ckalloc(maxNumCL * sizeof(ssize_t)); + maxNumCL = NUM_STATIC_POS; + clPosition = (int*) ckalloc (maxNumCL*sizeof(int)); } adjust = 0; @@ -2207,7 +2265,6 @@ TclSubstTokens( appendByteLength = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfCharBytes); append = utfCharBytes; - /* * If the backslash sequence we found is in a literal, and * represented a continuation line, we compute and store its @@ -2223,11 +2280,10 @@ TclSubstTokens( * correction. */ - if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') - && (tokenPtr->start[1] == '\n')) { + if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && + (tokenPtr->start[1] == '\n')) { if (isLiteral) { - size_t clPos; - + int clPos; if (result == 0) { clPos = 0; } else { @@ -2236,17 +2292,19 @@ TclSubstTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = ckrealloc(clPosition, - maxNumCL * sizeof(ssize_t)); + clPosition = (int*) ckrealloc ((char*)clPosition, + maxNumCL*sizeof(int)); } - clPosition[numCL++] = (ssize_t) clPos; + clPosition[numCL] = clPos; + numCL ++; } - adjust++; + adjust ++; } break; case TCL_TOKEN_COMMAND: { - /* TIP #280: Transfer line information to nested command */ + Interp *iPtr = (Interp *) interp; + iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { @@ -2255,27 +2313,21 @@ TclSubstTokens( */ int theline; - - TclAdvanceContinuations(&line, &clNextOuter, - tokenPtr->start - outerScript); + TclAdvanceContinuations (&line, &clNextOuter, + tokenPtr->start - outerScript); theline = line + adjust; + /* TIP #280: Transfer line information to nested command */ code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0, theline, clNextOuter, outerScript); - - TclAdvanceLines(&line, tokenPtr->start+1, - tokenPtr->start + tokenPtr->size - 1); - /* * Restore flag reset by nested eval for future bracketed * commands and their cmdframe setup */ - - if (inFile) { + if (inFile) { iPtr->evalFlags |= TCL_EVAL_FILE; } } iPtr->numLevels--; - TclResetCancellation(interp, 0); appendObj = Tcl_GetObjResult(interp); break; } @@ -2374,7 +2426,6 @@ TclSubstTokens( if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { Tcl_SetObjResult(interp, result); - /* * If the code found continuation lines (which implies that this * word is a literal), then we store the accumulated table of @@ -2393,7 +2444,7 @@ TclSubstTokens( */ if (maxNumCL) { - ckfree(clPosition); + ckfree ((char*) clPosition); } } else { Tcl_ResetResult(interp); @@ -2505,63 +2556,13 @@ TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - size_t length; + int length; const char *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( - const char *src, - size_t 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; - } - } - } - - return 1; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 |