diff options
| -rw-r--r-- | ChangeLog | 17 | ||||
| -rw-r--r-- | generic/tclBasic.c | 48 | ||||
| -rw-r--r-- | generic/tclCompile.c | 157 | ||||
| -rw-r--r-- | generic/tclCompile.h | 3 | ||||
| -rw-r--r-- | generic/tclInt.h | 6 | ||||
| -rw-r--r-- | generic/tclParse.c | 191 | ||||
| -rw-r--r-- | tests/parse.test | 4 |
7 files changed, 167 insertions, 259 deletions
@@ -1,3 +1,20 @@ +2007-05-30 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Removed code that dealt with + * generic/tclCompile.c: TCL_TOKEN_EXPAND_WORD tokens representing + * generic/tclCompile.h: expanded literal words. These sections were + mostly in place to enable [info frame] to discover line information + in expanded literals. Since the parser now generates a token for + each post-expansion word referring to the right location in the + original script string, [info frame] gets all the data it needs. + + * generic/tclInt.h: Revised the parser so that it never produces + * generic/tclParse.c: TCL_TOKEN_EXPAND_WORD tokens when parsing an + * tests/parse.test: expanded literal word; that is, something like + {*}{x y z}. Instead, generate the series of TCL_TOKEN_SIMPLE_WORD + tokens to represent the words that expansion of the literal string + produces. [RFE 1725186] + 2007-05-29 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixThrd.c (Tcl_JoinThread): fix for 64-bit handling of diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 33f5da7..6471e6f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.244 2007/04/20 05:51:08 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.245 2007/05/30 18:12:57 dgp Exp $ */ #include "tclInt.h" @@ -3926,14 +3926,6 @@ TclEvalEx( CmdFrame eeFrame; /* TIP #280 Structures for tracking of command * locations. */ - /* - * TIP #280. The array 'expand' has become tri-valued. - * 0 = No expansion - * 1 = Expansion, value is dynamically constructed ($var, [cmd]). - * 2 = NEW Expansion of a literal value. Here the system determines the - * actual line numbers within the literal. - */ - if (numBytes < 0) { numBytes = strlen(script); } @@ -4074,9 +4066,7 @@ TclEvalEx( TclAdvanceLines(&wordLine, wordStart, tokenPtr->start); wordStart = tokenPtr->start; - lines[objectsUsed] = - (TclWordKnownAtCompileTime(tokenPtr, NULL) - || TclWordSimpleExpansion(tokenPtr)) + lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1; if (eeFrame.type == TCL_LOCATION_SOURCE) { @@ -4109,8 +4099,7 @@ TclEvalEx( goto error; } expandRequested = 1; - expand[objectsUsed] = - TclWordSimpleExpansion(tokenPtr) ? 2 : 1; + expand[objectsUsed] = 1; objectsNeeded += (numElements ? numElements : 1); } else { @@ -4138,36 +4127,7 @@ TclEvalEx( objectsUsed = 0; while (wordIdx--) { - if (expand[wordIdx] == 2) { - /* - * TIP #280. The expansion is for a simple literal. - * Not only crack the list into its elements, - * determine the line numbers within it as well. - * - * The qualification of 'simple' ensures that the word - * does not contain backslash-subst, no way to get - * thrown off by embedded \n sequnces. - */ - - int numElements; - Tcl_Obj **elements, *temp = copy[wordIdx]; - int *eline; - - Tcl_ListObjGetElements(NULL, temp, &numElements, - &elements); - eline = (int *) ckalloc(numElements * sizeof(int)); - TclListLines(TclGetString(temp),lcopy[wordIdx], - numElements, eline); - - objectsUsed += numElements; - while (numElements--) { - lines[objIdx] = eline[numElements]; - objv[objIdx--] = elements[numElements]; - Tcl_IncrRefCount(elements[numElements]); - } - Tcl_DecrRefCount(temp); - ckfree((char *) eline); - } else if (expand[wordIdx]) { + if (expand[wordIdx]) { int numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 0bfe9bf..1862cb2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.117 2007/04/23 20:33:56 das Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.118 2007/05/30 18:12:58 dgp Exp $ */ #include "tclInt.h" @@ -1077,29 +1077,6 @@ TclWordKnownAtCompileTime( return 1; } -int -TclWordSimpleExpansion( - Tcl_Token *tokenPtr) /* Points to Tcl_Token we should check */ -{ - int numComponents = tokenPtr->numComponents; - - if (tokenPtr->type != TCL_TOKEN_EXPAND_WORD) { - return 0; - } - tokenPtr++; - while (numComponents--) { - switch (tokenPtr->type) { - case TCL_TOKEN_TEXT: - break; - - default: - return 0; - } - tokenPtr++; - } - return 1; -} - /* *---------------------------------------------------------------------- * @@ -1224,23 +1201,6 @@ TclCompileScript( if (parse.numWords > 0) { int expand = 0; /* Set if there are dynamic expansions * to handle */ - int eliterals = 0; /* Set if there are literal expansions - * to handle. Actually the number of - * words in the expanded literals. */ - int *exp = NULL; /* For literal expansions, #words in - * the expansion. Only valid if the - * associated expLen[] value is not - * NULL. Can be 0, expansion to - * nothing. */ - int **expLen = NULL; /* Array of array of integers. Each - * array holds the lengths of the - * items in the expanded list. NULL - * indicates unexpanded words, or - * dynamically expanded words. */ - char ***expItem = NULL; /* Array of arrays of strings, holding - * pointers to the list elements, - * inside of the parsed script. No - * copies. For NULL, see expLen. */ /* * If not the first command, pop the previous command's result @@ -1286,127 +1246,18 @@ TclCompileScript( /* * Check whether expansion has been requested for any of the - * words. NOTE: If a word to be expanded is actually a literal - * list we will do the expansion here, directly manipulating the - * token array. - * - * Due to the search for literal expansions it is not possible - * (anymore) to abort when a dynamic expansion is found. There - * might be a literal one coming after. + * words. */ - exp = (int *) TclStackAlloc(interp, sizeof(int) * parse.numWords); - expLen = (int **) TclStackAlloc(interp, - sizeof(int *) * parse.numWords); - expItem = (char ***) TclStackAlloc(interp, - sizeof(char **) * parse.numWords); - for (wordIdx = 0, tokenPtr = parse.tokenPtr; wordIdx < parse.numWords; wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { - exp[wordIdx] = -1; - expLen[wordIdx] = NULL; - expItem[wordIdx] = NULL; - if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - if (TclWordSimpleExpansion(tokenPtr)) { - const char *start = (tokenPtr+1)->start; - const char *end = - (tokenPtr+tokenPtr->numComponents)->start + - (tokenPtr+tokenPtr->numComponents)->size; - - if (TclMarkList(NULL, start, end, exp+wordIdx, - (const int **)(expLen+wordIdx), - (const char ***)(expItem+wordIdx)) != TCL_OK) { - /* - * We're trying to expand a literal that is not a - * well-formed list. No option but to punt the - * problem to run-time; arrange for compilation of - * this term as an expansion. - */ - - expand = 1; - } else { - eliterals += exp[wordIdx] ? exp[wordIdx] : 1; - } - } else { - expand = 1; - } + expand = 1; + break; } } - if (eliterals) { - Tcl_Token *copy = parse.tokenPtr; - int new; - int objIdx; - - parse.tokensAvailable += eliterals + eliterals; - - /* - * eliterals times 2 - simple_word, and text tokens. - */ - - parse.tokenPtr = (Tcl_Token *) - ckalloc(sizeof(Tcl_Token) * parse.tokensAvailable); - parse.numTokens = 0; - - for (objIdx=0, wordIdx=0, tokenPtr=copy, new=0; - wordIdx < parse.numWords; - wordIdx++, tokenPtr += tokenPtr->numComponents+1) { - if (expLen[wordIdx]) { - /* - * Expansion of a simple literal. We already have the - * list elements which become the words. Now we `just` - * have to create their tokens. The token array - * already has the proper size to contain them all. - */ - - int k; - for (k = 0; k < exp[wordIdx]; k++) { - Tcl_Token *t = &parse.tokenPtr[objIdx]; - - t->type = TCL_TOKEN_SIMPLE_WORD; - t->start = expItem[wordIdx][k]; - t->size = expLen[wordIdx][k]; - t->numComponents = 1; - t++; - - t->type = TCL_TOKEN_TEXT; - t->start = expItem[wordIdx][k]; - t->size = expLen[wordIdx][k]; - t->numComponents = 0; - - objIdx += 2; - new ++; - } - - ckfree((char *) expLen[wordIdx]); - ckfree((char *) expItem[wordIdx]); - } else { - /* - * Regular word token. Copy as is, including subtree. - */ - - int k; - - new++; - for (k=0 ; k<=tokenPtr->numComponents ; k++) { - parse.tokenPtr[objIdx++] = tokenPtr[k]; - } - } - } - parse.numTokens = objIdx; - parse.numWords = new; - - if (copy != parse.staticTokens) { - ckfree((char *) copy); - } - } - - TclStackFree(interp); /* expItem */ - TclStackFree(interp); /* expLen */ - TclStackFree(interp); /* exp */ - envPtr->numCommands++; currCmdIndex = (envPtr->numCommands - 1); lastTopLevelCmdIndex = currCmdIndex; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index f0a3117..f27843e 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.70 2007/04/03 01:34:37 msofer Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.71 2007/05/30 18:12:58 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -915,7 +915,6 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr); #endif MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); -MODULE_SCOPE int TclWordSimpleExpansion(Tcl_Token *tokenPtr); /* *---------------------------------------------------------------- diff --git a/generic/tclInt.h b/generic/tclInt.h index 05cab9c..ec0fd19 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.310 2007/05/11 20:59:13 patthoyts Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.311 2007/05/30 18:12:58 dgp Exp $ */ #ifndef _TCLINT @@ -3397,10 +3397,6 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, #include "tclIntPlatDecls.h" #include "tclTomMathDecls.h" - - -MODULE_SCOPE void TclPrintTokens (Tcl_Token* token, int words, int level); - #endif /* _TCLINT */ /* diff --git a/generic/tclParse.c b/generic/tclParse.c index 4e4379c..bcf788c 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.52 2007/05/18 18:39:30 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.53 2007/05/30 18:12:59 dgp Exp $ */ #include "tclInt.h" @@ -414,13 +414,146 @@ Tcl_ParseCommand( tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->size = src - tokenPtr->start; tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); - if ((tokenPtr->numComponents == 1) + if (expandWord) { + int i, isLiteral = 1; + + /* + * When a command includes a word that is an expanded literal; + * for example, {*}{1 2 3}, the parser performs that expansion + * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead + * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand() + * caller might have to expand. This notably makes it simpler for + * those callers that wish to track line endings, such as those + * that implement key parts of TIP 280. + * + * First check whether the thing to be expanded is a literal, + * in the sense of being composed entirely of TCL_TOKEN_TEXT + * tokens. + */ + + for (i = 1; i <= tokenPtr->numComponents; i++) { + if (tokenPtr[i].type != TCL_TOKEN_TEXT) { + isLiteral = 0; + break; + } + } + + if (isLiteral) { + int elemCount = 0, code = TCL_OK; + const char *nextElem, *listEnd, *elemStart; + + /* + * The word to be expanded is a literal, so determine the + * boundaries of the literal string to be treated as a list + * and expanded. That literal string starts at + * tokenPtr[1].start, and includes all bytes up to, but + * not including (tokenPtr[tokenPtr->numComponents].start + + * tokenPtr[tokenPtr->numComponents].size) + */ + + listEnd = (tokenPtr[tokenPtr->numComponents].start + + tokenPtr[tokenPtr->numComponents].size); + nextElem = tokenPtr[1].start; + + /* + * Step through the literal string, parsing and counting + * list elements. + */ + + while ((code == TCL_OK) && (nextElem < listEnd)) { + code = TclFindElement(NULL, nextElem, listEnd - nextElem, + &elemStart, &nextElem, NULL, NULL); + if (elemStart < listEnd) { + elemCount++; + } + } + + if (code != TCL_OK) { + + /* + * Some list element could not be parsed. This means + * the literal string was not in fact a valid list. + * Defer the handling of this to compile/eval time, where + * code is already in place to report the "attempt to + * expand a non-list" error. + */ + + tokenPtr->type = TCL_TOKEN_EXPAND_WORD; + } else if (elemCount == 0) { + + /* + * We are expanding a literal empty list. This means + * that the expanding word completely disappears, leaving + * no word generated this pass through the loop. Adjust + * accounting appropriately. + */ + + parsePtr->numWords--; + parsePtr->numTokens = wordIndex; + } else { + + /* + * Recalculate the number of Tcl_Tokens needed to store + * tokens representing the expanded list. + */ + + parsePtr->numWords += elemCount - 1; + parsePtr->numTokens = wordIndex + 2*elemCount; + while (parsePtr->numTokens >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + tokenPtr = &parsePtr->tokenPtr[wordIndex]; + + /* + * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for + * each element of the literal list we are expanding in + * place. Take care with the start and size fields of + * each token so they point to the right literal characters + * in the original script to represent the right expanded + * word value. + */ + + nextElem = tokenPtr[1].start; + while (isspace(UCHAR(*nextElem))) { + nextElem++; + } + while (nextElem < listEnd) { + tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; + tokenPtr->numComponents = 1; + tokenPtr->start = nextElem; + + tokenPtr++; + tokenPtr->type = TCL_TOKEN_TEXT; + tokenPtr->numComponents = 0; + TclFindElement(NULL, nextElem, listEnd - nextElem, + &(tokenPtr->start), &nextElem, + &(tokenPtr->size), NULL); + if (tokenPtr->start + tokenPtr->size == listEnd) { + tokenPtr[-1].size = listEnd - tokenPtr[-1].start; + } else { + tokenPtr[-1].size = tokenPtr->start + + tokenPtr->size - tokenPtr[-1].start; + tokenPtr[-1].size += (isspace(UCHAR( + tokenPtr->start[tokenPtr->size])) == 0); + } + + tokenPtr++; + } + } + } else { + + /* + * The word to be expanded is not a literal, so defer + * expansion to compile/eval time by marking with a + * TCL_TOKEN_EXPAND_WORD token. + */ + + tokenPtr->type = TCL_TOKEN_EXPAND_WORD; + } + } else if ((tokenPtr->numComponents == 1) && (tokenPtr[1].type == TCL_TOKEN_TEXT)) { tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; } - if (expandWord) { - tokenPtr->type = TCL_TOKEN_EXPAND_WORD; - } /* * Do two additional checks: (a) make sure we're really at the end of @@ -2351,54 +2484,6 @@ TclIsLocalScalar( return 1; } -#define TCL_TOKEN_WORD 1 -#define TCL_TOKEN_SIMPLE_WORD 2 -#define TCL_TOKEN_TEXT 4 -#define TCL_TOKEN_BS 8 -#define TCL_TOKEN_COMMAND 16 -#define TCL_TOKEN_VARIABLE 32 -#define TCL_TOKEN_SUB_EXPR 64 -#define TCL_TOKEN_OPERATOR 128 -#define TCL_TOKEN_EXPAND_WORD 256 - -static void -TclPrintToken( - Tcl_Token *token, - int idx, - int level) -{ - int i; - - for (i=0 ; i<level ; i++) { - fprintf(stdout, " "); - } - level++; - - fprintf(stdout, "[%3d] @%p/%4d", idx, token->start, token->size); - if (token->numComponents == 0) { - fprintf(stdout," <%.*s>\n", token->size, token->start); - } else { - fprintf(stdout,"\n"); - } - fflush(stdout); - if (token->numComponents > 0) { - TclPrintTokens(token+1,token->numComponents, level); - } -} - -void -TclPrintTokens( - Tcl_Token *token, - int words, - int level) -{ - int k; - - for (k=0 ; k<words ; k++, token += (1+token->numComponents)) { - TclPrintToken(token, k, level); - } -} - /* * Local Variables: * mode: c diff --git a/tests/parse.test b/tests/parse.test index a89e991..07c9f47 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parse.test,v 1.27 2007/03/15 22:05:21 mdejong Exp $ +# RCS: @(#) $Id: parse.test,v 1.28 2007/05/30 18:12:59 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -217,7 +217,7 @@ test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser { } {- {{*} } 1 simple {{*}} 1 text * 0 {}} test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*}x} 0 -} {- {{*}x} 1 expand {{*}x} 1 text x 0 {}} +} {- {{*}x} 1 simple x 1 text x 0 {}} test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{*} } 0 |