Attachment "1016167.patch" to
ticket [1016167fff]
added by
dgp
2004-08-26 01:30:06.
Index: generic/tclTimer.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTimer.c,v
retrieving revision 1.8
diff -u -r1.8 tclTimer.c
--- generic/tclTimer.c 6 Apr 2004 22:25:55 -0000 1.8
+++ generic/tclTimer.c 25 Aug 2004 18:22:13 -0000
@@ -765,6 +765,12 @@
*/
if (assocPtr == NULL) {
+ Tcl_Command token = Tcl_GetCommandFromObj(interp, objv[0]);
+ Tcl_Command originalToken = TclGetOriginalCommand(token);
+
+ if (originalToken != NULL) {
+ token = originalToken;
+ }
assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
assocPtr->interp = interp;
assocPtr->firstAfterPtr = NULL;
@@ -776,8 +782,8 @@
cmdInfo.objClientData = (ClientData) assocPtr;
cmdInfo.deleteProc = NULL;
cmdInfo.deleteData = (ClientData) assocPtr;
- Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length),
- &cmdInfo);
+
+ Tcl_SetCommandInfoFromToken(token, &cmdInfo);
}
/*
Index: tests/timer.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/timer.test,v
retrieving revision 1.8
diff -u -r1.8 timer.test
--- tests/timer.test 19 May 2004 13:03:37 -0000 1.8
+++ tests/timer.test 25 Aug 2004 18:22:14 -0000
@@ -538,6 +538,18 @@
set x
} {before after2 after4}
+test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
+ interp create slave
+ slave eval namespace export after
+ slave eval namespace eval foo namespace import ::after
+} -body {
+ slave eval foo::after 1
+ slave eval namespace origin foo::after
+} -cleanup {
+ # Bug will cause crash here; would cause failure otherwise
+ interp delete slave
+} -result ::after
+
# cleanup
::tcltest::cleanupTests
return
