summaryrefslogtreecommitdiffstats
path: root/generic/tclInterp.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-09-14 17:45:24 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-09-14 17:45:24 (GMT)
commit807dad29a3e4ffb856a0814751efc851f5d6bfbe (patch)
treea10ee71554e5e45668b3ad9d290d1e7f0b1e4a18 /generic/tclInterp.c
parent8cb023658d6e613c6a76db26b0b5568b6e0b2bb6 (diff)
downloadtcl-807dad29a3e4ffb856a0814751efc851f5d6bfbe.zip
tcl-807dad29a3e4ffb856a0814751efc851f5d6bfbe.tar.gz
tcl-807dad29a3e4ffb856a0814751efc851f5d6bfbe.tar.bz2
* 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.
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r--generic/tclInterp.c50
1 files changed, 34 insertions, 16 deletions
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]);