diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | doc/interp.n | 56 | ||||
| -rw-r--r-- | generic/tclInterp.c | 50 | ||||
| -rw-r--r-- | tests/interp.test | 17 |
4 files changed, 85 insertions, 45 deletions
@@ -1,3 +1,10 @@ +2004-09-10 Miguel Sofer <msofer@users.sf.net> + + * doc/interp.n: + * generic/tclInterp.c (TclPreventAliasLoop, AliasCreate): + * tests/interp.test (17.4-6, 19.3-4): fixing problems with + renaming of aliases [Bugs 707104 1026493]. Fix designed by dgp. + 2004-09-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclNamesp.c (NsEnsembleImplementationCmd): Add token diff --git a/doc/interp.n b/doc/interp.n index 1174877..a1b50f1 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: interp.n,v 1.14 2004/08/02 20:55:36 dgp Exp $ +'\" RCS: @(#) $Id: interp.n,v 1.15 2004/09/14 17:45:36 msofer Exp $ '\" .so man.macros .TH interp n 7.6 Tcl "Tcl Built-In Commands" @@ -85,17 +85,17 @@ slave interpreters, and to share or transfer channels between interpreters. It can have any of several forms, depending on the \fIoption\fR argument: .TP -\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR +\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR Returns a Tcl list whose elements are the \fItargetCmd\fR and -\fIarg\fRs associated with the alias named \fIsrcCmd\fR -(all of these are the values specified when the alias was -created; it is possible that the actual source command in the -slave is different from \fIsrcCmd\fR if it was renamed). +\fIarg\fRs associated with the alias represented by \fIsrcToken\fR +(this is the value returned when the alias was +created; it is possible that the name of the source command in the +slave is different from \fIsrcToken\fR). .TP -\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fB{}\fR -Deletes the alias for \fIsrcCmd\fR in the slave interpreter identified by +\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR +Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by \fIsrcPath\fR. -\fIsrcCmd\fR refers to the name under which the alias +\fIsrcToken\fR refers to the value returned when the alias was created; if the source command has been renamed, the renamed command will be deleted. .TP @@ -121,11 +121,17 @@ already exist; it is not created by this command. The alias arranges for the given target command to be invoked in the target interpreter whenever the given source command is invoked in the source interpreter. See ALIAS INVOCATION below for -more details. +more details. +The command returns a token that uniquely identifies the command created +\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but +does not have to be equal to \fIsrcCmd\fR. .TP \fBinterp\fR \fBaliases \fR?\fIpath\fR? -This command returns a Tcl list of the names of all the source commands for -aliases defined in the interpreter identified by \fIpath\fR. +This command returns a Tcl list of the tokens of all the source commands for +aliases defined in the interpreter identified by \fIpath\fR. The tokens +correspond to the values returned when +the aliases were created (which may not be the same +as the current names of the commands). .TP \fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? Creates a slave interpreter identified by \fIpath\fR and a new command, @@ -296,22 +302,21 @@ and the \fIarg\fRs determine the exact behavior of the command. The valid forms of this command are: .TP \fIslave \fBaliases\fR -Returns a Tcl list whose elements are the names of all the -aliases in \fIslave\fR. The names returned are the \fIsrcCmd\fR -values used when the aliases were created (which may not be the same -as the current names of the commands, if they have been -renamed). +Returns a Tcl list whose elements are the tokens of all the +aliases in \fIslave\fR. The tokens correspond to the values returned when +the aliases were created (which may not be the same +as the current names of the commands). .TP -\fIslave \fBalias \fIsrcCmd\fR +\fIslave \fBalias \fIsrcToken\fR Returns a Tcl list whose elements are the \fItargetCmd\fR and -\fIarg\fRs associated with the alias named \fIsrcCmd\fR -(all of these are the values specified when the alias was +\fIarg\fRs associated with the alias represented by \fIsrcToken\fR +(this is the value returned when the alias was created; it is possible that the actual source command in the -slave is different from \fIsrcCmd\fR if it was renamed). +slave is different from \fIsrcToken\fR). .TP -\fIslave \fBalias \fIsrcCmd \fB{}\fR -Deletes the alias for \fIsrcCmd\fR in the slave interpreter. -\fIsrcCmd\fR refers to the name under which the alias +\fIslave \fBalias \fIsrcToken \fB{}\fR +Deletes the alias for \fIsrcToken\fR in the slave interpreter. +\fIsrcToken\fR refers to the value returned when the alias was created; if the source command has been renamed, the renamed command will be deleted. .TP @@ -322,6 +327,9 @@ The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional arguments, prepended before any arguments passed in the invocation of \fIsrcCmd\fR. See ALIAS INVOCATION below for details. +The command returns a token that uniquely identifies the command created +\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but +does not have to be equal to \fIsrcCmd\fR. .TP \fIslave \fBeval \fIarg \fR?\fIarg ..\fR? This command concatenates all of the \fIarg\fR arguments in diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 70c3356..969b546 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.44 2004/08/18 19:59:00 kennykb Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.45 2004/09/14 17:45:36 msofer Exp $ */ #include "tclInt.h" @@ -125,7 +125,10 @@ TCL_DECLARE_MUTEX(cntMutex) */ typedef struct Alias { - Tcl_Obj *namePtr; /* Name of alias command in slave interp. */ + Tcl_Obj *token; /* Token for the alias command in the slave + * interp. This used to be the command name + * in the slave when the alias was first + * created. */ Tcl_Interp *targetInterp; /* Interp in which target command will be * invoked. */ Tcl_Command slaveCmd; /* Source command in slave interpreter, @@ -1325,7 +1328,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd) Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot define or rename alias \"", - Tcl_GetString(aliasPtr->namePtr), + Tcl_GetCommandName(cmdInterp, cmd), "\": interpreter deleted", (char *) NULL); return TCL_ERROR; } @@ -1341,7 +1344,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd) if (aliasCmdPtr == cmdPtr) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot define or rename alias \"", - Tcl_GetString(aliasPtr->namePtr), + Tcl_GetCommandName(cmdInterp, cmd), "\": would create a loop", (char *) NULL); return TCL_ERROR; } @@ -1401,8 +1404,8 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr, aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) + objc * sizeof(Tcl_Obj *))); - aliasPtr->namePtr = namePtr; - Tcl_IncrRefCount(aliasPtr->namePtr); + aliasPtr->token = namePtr; + Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = masterInterp; aliasPtr->objc = objc + 1; @@ -1433,7 +1436,7 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr, Command *cmdPtr; - Tcl_DecrRefCount(aliasPtr->namePtr); + Tcl_DecrRefCount(aliasPtr->token); Tcl_DecrRefCount(targetNamePtr); for (i = 0; i < objc; i++) { Tcl_DecrRefCount(objv[i]); @@ -1457,23 +1460,38 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr, } /* - * Make an entry in the alias table. If it already exists delete - * the alias command. Then retry. + * Make an entry in the alias table. If it already exists, retry. */ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; while (1) { - Alias *oldAliasPtr; + Tcl_Obj *newToken; char *string; - string = Tcl_GetString(namePtr); + string = Tcl_GetString(aliasPtr->token); hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new); if (new != 0) { break; } - oldAliasPtr = (Alias *) Tcl_GetHashValue(hPtr); - Tcl_DeleteCommandFromToken(slaveInterp, oldAliasPtr->slaveCmd); + /* + * The alias name cannot be used as unique token, it is already + * taken. We can produce a unique token by prepending "::" + * repeatedly. This algorithm is a stop-gap to try to maintain + * the command name as token for most use cases, fearful of + * possible backwards compat problems. A better algorithm would + * produce unique tokens that need not be related to the command + * name. + * + * ATTENTION: the tests in interp.test and possibly safe.test + * depend on the precise definition of these tokens. + */ + + newToken = Tcl_NewStringObj("::",-1); + Tcl_AppendObjToObj(newToken, aliasPtr->token); + Tcl_DecrRefCount(aliasPtr->token); + aliasPtr->token = newToken; + Tcl_IncrRefCount(aliasPtr->token); } aliasPtr->aliasEntryPtr = hPtr; @@ -1504,7 +1522,7 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr, Tcl_SetHashValue(hPtr, (ClientData) targetPtr); aliasPtr->targetEntryPtr = hPtr; - Tcl_SetObjResult(interp, namePtr); + Tcl_SetObjResult(interp, aliasPtr->token); Tcl_Release(slaveInterp); Tcl_Release(masterInterp); @@ -1635,7 +1653,7 @@ AliasList(interp, slaveInterp) entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch); for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) { aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr); - Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr); + Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token); } return TCL_OK; } @@ -1751,7 +1769,7 @@ AliasObjCmdDeleteProc(clientData) aliasPtr = (Alias *) clientData; - Tcl_DecrRefCount(aliasPtr->namePtr); + Tcl_DecrRefCount(aliasPtr->token); objv = &aliasPtr->objPtr; for (i = 0; i < aliasPtr->objc; i++) { Tcl_DecrRefCount(objv[i]); diff --git a/tests/interp.test b/tests/interp.test index 1cda10a..3909ef1 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.40 2004/08/18 19:59:08 kennykb Exp $ +# RCS: @(#) $Id: interp.test,v 1.41 2004/09/14 17:45:37 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -662,14 +662,21 @@ test interp-17.4 {alias loop prevention} { interp create x interp alias x b x a list [catch {x eval rename b a} msg] $msg -} {1 {cannot define or rename alias "b": would create a loop}} +} {1 {cannot define or rename alias "a": would create a loop}} test interp-17.5 {alias loop prevention} { catch {interp delete x} interp create x x alias z l1 interp alias {} l2 x z list [catch {rename l2 l1} msg] $msg -} {1 {cannot define or rename alias "l2": would create a loop}} +} {1 {cannot define or rename alias "l1": would create a loop}} +test interp-17.6 {alias loop prevention} { + catch {interp delete x} + interp create x + interp alias x a x b + x eval rename a c + list [catch {x eval rename c b} msg] $msg +} {1 {cannot define or rename alias "b": would create a loop}} # # Test robustness of Tcl_DeleteInterp when applied to a slave interpreter. @@ -788,7 +795,7 @@ test interp-19.3 {alias deletion} { catch {interp eval a foo} msg interp delete a set msg -} {invalid command name "zop"} +} {invalid command name "bar"} test interp-19.4 {alias deletion} { catch {interp delete a} interp create a @@ -817,7 +824,7 @@ test interp-19.6 {alias deletion} { set s [interp aliases a] interp delete a set s -} foo +} {::foo foo} test interp-19.7 {alias deletion, renaming} { catch {interp delete a} interp create a |