summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-05-30 18:12:57 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-05-30 18:12:57 (GMT)
commitc3a6364780e6096f9665ff4b903d52e88abec903 (patch)
tree3556fc80b8c80f1b647b426b8d1dfdf33d4e09e2
parentdd4bd718f68c159cfd56b0a21fb425a8fdf4941a (diff)
downloadtcl-c3a6364780e6096f9665ff4b903d52e88abec903.zip
tcl-c3a6364780e6096f9665ff4b903d52e88abec903.tar.gz
tcl-c3a6364780e6096f9665ff4b903d52e88abec903.tar.bz2
* 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]
-rw-r--r--ChangeLog17
-rw-r--r--generic/tclBasic.c48
-rw-r--r--generic/tclCompile.c157
-rw-r--r--generic/tclCompile.h3
-rw-r--r--generic/tclInt.h6
-rw-r--r--generic/tclParse.c191
-rw-r--r--tests/parse.test4
7 files changed, 167 insertions, 259 deletions
diff --git a/ChangeLog b/ChangeLog
index 8539bd6..fa8dd5a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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