diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 128 | ||||
| -rw-r--r-- | tests/compile.test | 13 |
3 files changed, 94 insertions, 53 deletions
@@ -1,5 +1,11 @@ 2002-08-26 Miguel Sofer <msofer@users.sourceforge.net> + * generic/tclCompCmds.c: fix for [Bug 599788] (error in element + name causing segfault), reported by Tom Wilkason. Fixed by copying + the tokens instead of the source string. + +2002-08-26 Miguel Sofer <msofer@users.sourceforge.net> + * generic/tclThreadAlloc.c: small optimisation, reducing the new allocator's overhead. diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 680061e..75234c9 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.32 2002/08/05 03:24:40 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.33 2002/08/26 17:38:54 msofer Exp $ */ #include "tclInt.h" @@ -3106,16 +3106,16 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, int *simpleVarNamePtr; /* must not be NULL */ int *isScalarPtr; /* must not be NULL */ { - Tcl_Parse elemParse; - int gotElemParse = 0; register CONST char *p; CONST char *name, *elName; register int i, n; int nameChars, elNameChars, simpleVarName, localIndex; int code = TCL_OK; - Tcl_DString copy; - Tcl_DStringInit(©); + Tcl_Token *elemTokenPtr = NULL; + int elemTokenCount = 0; + int allocedTokens = 0; + int removedParen = 0; /* * Decide if we can use a frame slot for the var/array name or if we @@ -3148,8 +3148,11 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, name = varTokenPtr[1].start; nameChars = varTokenPtr[1].size; - /* last char is ')' => potential array reference */ if ( *(name + nameChars - 1) == ')') { + /* + * last char is ')' => potential array reference. + */ + for (i = 0, p = name; i < nameChars; i++, p++) { if (*p == '(') { elName = p + 1; @@ -3158,29 +3161,32 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, break; } } - } - /* - * If elName contains any double quotes ("), we can't inline - * compile the element script using the replace '()' by '"' - * technique below. - */ + if ((elName != NULL) && elNameChars) { + /* + * An array element, the element name is a simple + * string: assemble the corresponding token. + */ - for (i = 0, p = elName; i < elNameChars; i++, p++) { - if (*p == '"') { - simpleVarName = 0; - break; + elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = elNameChars; + elemTokenPtr->numComponents = 0; + elemTokenCount = 1; } } } else if (((n = varTokenPtr->numComponents) > 1) && (varTokenPtr[1].type == TCL_TOKEN_TEXT) && (varTokenPtr[n].type == TCL_TOKEN_TEXT) && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { - simpleVarName = 0; /* * Check for parentheses inside first token */ + + simpleVarName = 0; for (i = 0, p = varTokenPtr[1].start; i < varTokenPtr[1].size; i++, p++) { if (*p == '(') { @@ -3189,24 +3195,56 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } } if (simpleVarName) { + int remainingChars; + + /* + * Check the last token: if it is just ')', do not count + * it. Otherwise, remove the ')' and flag so that it is + * restored at the end. + */ + + if (varTokenPtr[n].size == 1) { + --n; + } else { + --varTokenPtr[n].size; + removedParen = n; + } + name = varTokenPtr[1].start; nameChars = p - varTokenPtr[1].start; elName = p + 1; + remainingChars = (varTokenPtr[2].start - p) - 1; elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2; - /* - * If elName contains any double quotes ("), we can't inline - * compile the element script using the replace '()' by '"' - * technique below. - */ - - for (i = 0, p = elName; i < elNameChars; i++, p++) { - if (*p == '"') { - simpleVarName = 0; - break; - } - } - } + if (remainingChars) { + /* + * Make a first token with the extra characters in the first + * token. + */ + + elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = remainingChars; + elemTokenPtr->numComponents = 0; + elemTokenCount = n; + + /* + * Copy the remaining tokens. + */ + + memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]), + ((n-1) * sizeof(Tcl_Token))); + } else { + /* + * Use the already available tokens. + */ + + elemTokenPtr = &varTokenPtr[2]; + elemTokenCount = n - 1; + } + } } if (simpleVarName) { @@ -3247,25 +3285,9 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, */ if (elName != NULL) { - /* - * Temporarily replace the '(' and ')' by '"'s. - */ - Tcl_DStringAppend(©, "\"", 1); - Tcl_DStringAppend(©, elName, elNameChars); - Tcl_DStringAppend(©, "\"", 1); - code = Tcl_ParseCommand(interp, Tcl_DStringValue(©), - elNameChars+2, /*nested*/ 0, &elemParse); - gotElemParse = 1; - if ((code != TCL_OK) || (elemParse.numWords > 1)) { - char buffer[160]; - sprintf(buffer, "\n (parsing index for array \"%.*s\")", - TclMin(nameChars, 100), name); - Tcl_AddObjErrorInfo(interp, buffer, -1); - code = TCL_ERROR; - goto done; - } else if (elemParse.numWords == 1) { - code = TclCompileTokens(interp, elemParse.tokenPtr+1, - elemParse.tokenPtr->numComponents, envPtr); + if (elNameChars) { + code = TclCompileTokens(interp, elemTokenPtr, + elemTokenCount, envPtr); if (code != TCL_OK) { goto done; } @@ -3286,10 +3308,12 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } done: - if (gotElemParse) { - Tcl_FreeParse(&elemParse); + if (removedParen) { + ++varTokenPtr[removedParen].size; + } + if (allocedTokens) { + ckfree((char *) elemTokenPtr); } - Tcl_DStringFree(©); *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; *isScalarPtr = (elName == NULL); diff --git a/tests/compile.test b/tests/compile.test index a5abce7..f3c1a08 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -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: compile.test,v 1.22 2002/07/10 11:56:44 dgp Exp $ +# RCS: @(#) $Id: compile.test,v 1.23 2002/08/26 17:38:54 msofer Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -323,6 +323,17 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} +# Special test for compiling tokens from a copy of the source +# string [Bug #599788] +test compile-14.1 {testing errors in element name; segfault?} {} { + catch {set a([error])} msg1 + catch {set bubba([join $abba $jubba]) $vol} msg2 + list $msg1 $msg2 +} {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}} + + + + # cleanup catch {rename p ""} catch {namespace delete test_ns_compile} |