Attachment "707104.patch2" to
ticket [707104ffff]
added by
msofer
2004-09-12 09:05:27.
Index: doc/interp.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/interp.n,v
retrieving revision 1.14
diff -u -r1.14 interp.n
--- doc/interp.n 2 Aug 2004 20:55:36 -0000 1.14
+++ doc/interp.n 12 Sep 2004 01:59:08 -0000
@@ -85,17 +85,17 @@
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 @@
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 @@
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 @@
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
Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.44
diff -u -r1.44 tclInterp.c
--- generic/tclInterp.c 18 Aug 2004 19:59:00 -0000 1.44
+++ generic/tclInterp.c 12 Sep 2004 01:59:09 -0000
@@ -125,7 +125,10 @@
*/
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 @@
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 @@
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 @@
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 @@
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 @@
}
/*
- * 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 @@
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 @@
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 @@
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]);
Index: tests/interp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/interp.test,v
retrieving revision 1.40
diff -u -r1.40 interp.test
--- tests/interp.test 18 Aug 2004 19:59:08 -0000 1.40
+++ tests/interp.test 12 Sep 2004 01:59:11 -0000
@@ -662,14 +662,21 @@
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 @@
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 @@
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
