diff options
Diffstat (limited to 'generic/tclParse.c')
| -rw-r--r-- | generic/tclParse.c | 515 |
1 files changed, 288 insertions, 227 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c index 3a04df4..b40b636 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -14,8 +14,6 @@ */ #include "tclInt.h" -#include "tclParse.h" -#include <assert.h> /* * The following table provides parsing information about each possible 8-bit @@ -43,7 +41,18 @@ * TYPE_BRACE - Character is a curly brace (either left or right). */ -const char tclCharTypeTable[] = { +#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: */ @@ -167,21 +176,19 @@ static int ParseTokens(const char *src, int numBytes, int mask, int flags, Tcl_Parse *parsePtr); static int ParseWhiteSpace(const char *src, int numBytes, int *incompletePtr, char *typePtr); -static int ParseAllWhiteSpace(const char *src, int numBytes, - int *incompletePtr); /* *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ @@ -244,7 +251,7 @@ Tcl_ParseCommand( * 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,8 +268,7 @@ Tcl_ParseCommand( if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't parse a NULL pointer", -1)); + Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); } return TCL_ERROR; } @@ -300,43 +306,9 @@ Tcl_ParseCommand( */ parsePtr->commandStart = src; - type = CHAR_TYPE(*src); - scanned = 1; /* Can't have missing whitepsace before first word. */ while (1) { int expandWord = 0; - /* Are we at command termination? */ - - if ((numBytes == 0) || (type & terminators) != 0) { - parsePtr->term = src; - parsePtr->commandSize = src + (numBytes != 0) - - parsePtr->commandStart; - return TCL_OK; - } - - /* Are we missing white space after previous word? */ - - if (scanned == 0) { - if (src[-1] == '"') { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-quote", -1)); - } - parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; - } else { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-brace", -1)); - } - parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; - } - parsePtr->term = src; - error: - Tcl_FreeParse(parsePtr); - parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; - return TCL_ERROR; - } - /* * Create the token for the word. */ @@ -346,6 +318,23 @@ Tcl_ParseCommand( tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->type = TCL_TOKEN_WORD; + /* + * Skip white space before the word. Also skip a backslash-newline + * sequence: it should be treated just like white space. + */ + + scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); + src += scanned; + numBytes -= scanned; + if (numBytes == 0) { + parsePtr->term = src; + break; + } + if ((type & terminators) != 0) { + parsePtr->term = src; + src++; + break; + } tokenPtr->start = src; parsePtr->numTokens++; parsePtr->numWords++; @@ -507,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); @@ -565,12 +553,52 @@ Tcl_ParseCommand( tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; } - /* Parse the whitespace between words. */ + /* + * 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. + */ scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); - src += scanned; - numBytes -= scanned; + if (scanned) { + src += scanned; + numBytes -= scanned; + continue; + } + + if (numBytes == 0) { + parsePtr->term = src; + break; + } + if ((type & terminators) != 0) { + parsePtr->term = src; + src++; + break; + } + if (src[-1] == '"') { + if (interp != NULL) { + Tcl_SetResult(interp, "extra characters after close-quote", + TCL_STATIC); + } + parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; + } else { + if (interp != NULL) { + Tcl_SetResult(interp, "extra characters after close-brace", + TCL_STATIC); + } + parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; + } + parsePtr->term = src; + goto error; } + + parsePtr->commandSize = src - parsePtr->commandStart; + return TCL_OK; + + error: + Tcl_FreeParse(parsePtr); + parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; + return TCL_ERROR; } /* @@ -685,7 +713,7 @@ ParseWhiteSpace( if (p[1] != '\n') { break; } - p += 2; + p+=2; if (--numBytes == 0) { *incompletePtr = 1; break; @@ -712,32 +740,23 @@ ParseWhiteSpace( *---------------------------------------------------------------------- */ -static int -ParseAllWhiteSpace( +int +TclParseAllWhiteSpace( const char *src, /* First character to parse. */ - int numBytes, /* Max number of byes to scan */ - int *incompletePtr) /* Set true if parse is incomplete. */ + int numBytes) /* Max number of byes to scan */ { + int dummy; char type; const char *p = src; do { - int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); + int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type); p += scanned; numBytes -= scanned; } while (numBytes && (*p == '\n') && (p++, --numBytes)); return (p-src); } - -int -TclParseAllWhiteSpace( - const char *src, /* First character to parse. */ - int numBytes) /* Max number of byes to scan */ -{ - int dummy; - return ParseAllWhiteSpace(src, numBytes, &dummy); -} /* *---------------------------------------------------------------------- @@ -765,21 +784,21 @@ int TclParseHex( const char *src, /* First character to parse. */ int numBytes, /* Max number of byes to scan */ - int *resultPtr) /* Points to storage provided by caller where - * the character resulting from the + 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') { @@ -804,14 +823,14 @@ 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. * *---------------------------------------------------------------------- */ @@ -829,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]; @@ -887,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". @@ -910,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 { @@ -937,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; } @@ -963,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; } @@ -979,7 +987,7 @@ TclParseBackslash( if (readPtr != NULL) { *readPtr = count; } - return Tcl_UniCharToUtf(result, dst); + return Tcl_UniCharToUtf((int) result, dst); } /* @@ -991,11 +999,11 @@ 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. * *---------------------------------------------------------------------- */ @@ -1009,12 +1017,17 @@ ParseComment( * command. */ { register const char *p = src; - int incomplete = parsePtr->incomplete; while (numBytes) { - int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); - p += scanned; - numBytes -= scanned; + char type; + int scanned; + + do { + scanned = ParseWhiteSpace(p, numBytes, + &parsePtr->incomplete, &type); + p += scanned; + numBytes -= scanned; + } while (numBytes && (*p == '\n') && (p++,numBytes--)); if ((numBytes == 0) || (*p != '#')) { break; @@ -1023,28 +1036,35 @@ ParseComment( parsePtr->commentStart = p; } - p++; - numBytes--; while (numBytes) { - if (*p == '\n') { - p++; - numBytes--; - break; - } if (*p == '\\') { + scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete, + &type); + if (scanned) { + p += scanned; + numBytes -= scanned; + } else { + /* + * General backslash substitution in comments isn't part + * of the formal spec, but test parse-15.47 and history + * indicate that it has been the de facto rule. Don't + * change it now. + */ + + TclParseBackslash(p, numBytes, &scanned, NULL); + p += scanned; + numBytes -= scanned; + } + } else { p++; numBytes--; - if (numBytes == 0) { + if (p[-1] == '\n') { break; } } - incomplete = (*p == '\n'); - p++; - numBytes--; } parsePtr->commentSize = p - parsePtr->commentStart; } - parsePtr->incomplete = incomplete; return (p - src); } @@ -1136,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. */ @@ -1160,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) { @@ -1194,8 +1215,8 @@ ParseTokens( } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-bracket", -1)); + Tcl_SetResult(parsePtr->interp, + "missing close-bracket", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; @@ -1313,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; } } @@ -1428,8 +1449,8 @@ Tcl_ParseVarName( } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace for variable name", -1)); + Tcl_SetResult(parsePtr->interp, + "missing close-brace for variable name", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; parsePtr->term = tokenPtr->start-1; @@ -1486,8 +1507,8 @@ Tcl_ParseVarName( } if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing )", -1)); + Tcl_SetResult(parsePtr->interp, "missing )", + TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_PAREN; parsePtr->term = src; @@ -1552,7 +1573,8 @@ 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, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); @@ -1584,13 +1606,16 @@ Tcl_ParseVar( * At this point we should have an object containing the value of a * variable. Just return the string from that object. * - * Since TclSubstTokens above returned TCL_OK, we know that objPtr - * is shared. It is in both the interp result and the value of the - * variable. Returning the string relies on that to be true. + * This should have returned the object for the user to manage, but + * instead we have some weak reference to the string value in the object, + * which is why we make sure the object exists after resetting the result. + * This isn't ideal, but it's the best we can do with the current + * documented interface. -- hobbs */ - assert( Tcl_IsShared(objPtr) ); - + if (!Tcl_IsShared(objPtr)) { + Tcl_IncrRefCount(objPtr); + } Tcl_ResetResult(interp); return TclGetString(objPtr); } @@ -1633,7 +1658,7 @@ Tcl_ParseBraces( * 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 @@ -1760,8 +1785,7 @@ Tcl_ParseBraces( goto error; } - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace", -1)); + Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC); /* * Guess if the problem is due to comments by searching the source string @@ -1783,8 +1807,8 @@ Tcl_ParseBraces( break; case '#' : if (openBrace && TclIsSpaceProc(src[-1])) { - Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp), - ": possible unbalanced brace in comment", -1); + Tcl_AppendResult(parsePtr->interp, + ": possible unbalanced brace in comment", NULL); goto error; } break; @@ -1835,7 +1859,7 @@ Tcl_ParseQuotedString( * 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 @@ -1863,8 +1887,7 @@ Tcl_ParseQuotedString( } if (*parsePtr->term != '"') { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing \"", -1)); + Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; parsePtr->term = start; @@ -1884,42 +1907,33 @@ Tcl_ParseQuotedString( /* *---------------------------------------------------------------------- * - * TclSubstParse -- + * Tcl_SubstObj -- * - * 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. + * This function performs the substitutions specified on the given string + * as described in the user documentation for the "subst" Tcl command. * * 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, - int 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. */ { - int 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); @@ -1931,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] @@ -2001,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; } @@ -2033,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 == @@ -2078,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); } } @@ -2094,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. * *---------------------------------------------------------------------- */ @@ -2118,30 +2188,29 @@ TclSubstTokens( * integer representing the number of tokens * left to be substituted will be written */ int line, /* The line the script starts on. */ - 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 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; - int *clPosition = NULL; - Interp *iPtr = (Interp *) interp; + int* clPosition = NULL; + Interp* iPtr = (Interp*) interp; int inFile = iPtr->evalFlags & TCL_EVAL_FILE; /* @@ -2158,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(int)); + maxNumCL = NUM_STATIC_POS; + clPosition = (int*) ckalloc (maxNumCL*sizeof(int)); } adjust = 0; @@ -2196,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 @@ -2212,31 +2280,31 @@ TclSubstTokens( * correction. */ - if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') - && (tokenPtr->start[1] == '\n')) { + if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && + (tokenPtr->start[1] == '\n')) { if (isLiteral) { int clPos; - if (result == 0) { clPos = 0; } else { - TclGetStringFromObj(result, &clPos); + Tcl_GetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = ckrealloc(clPosition, - maxNumCL * sizeof(int)); + clPosition = (int*) ckrealloc ((char*)clPosition, + maxNumCL*sizeof(int)); } clPosition[numCL] = clPos; - numCL++; + 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) { @@ -2245,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; } @@ -2364,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 @@ -2383,7 +2444,7 @@ TclSubstTokens( */ if (maxNumCL) { - ckfree(clPosition); + ckfree ((char*) clPosition); } } else { Tcl_ResetResult(interp); @@ -2496,7 +2557,7 @@ TclObjCommandComplete( * check. */ { int length; - const char *script = TclGetStringFromObj(objPtr, &length); + const char *script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); } |