From 3060491426e52099c85b053985225c8518fa0d4e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 25 Aug 2004 22:21:17 +0000
Subject:         * tests/timer.test (timer-10.1):        Test for Bug 1016167.
         * generic/tclTimer.c:   Workaround for situation when a        
 [namespace import] causes the objv[0] value to be something         other
 than what Tcl_AfterObjCmd expects.  [Bug 1016167].

---
 ChangeLog          | 15 +++++++++++----
 generic/tclTimer.c | 12 +++++++++---
 tests/timer.test   | 14 +++++++++++++-
 3 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index c4bf470..9a6363f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-08-25  Don Porter  <dgp@users.sourceforge.net>
+
+	* tests/timer.test (timer-10.1):	Test for Bug 1016167.
+	* generic/tclTimer.c:	Workaround for situation when a
+	[namespace import] causes the objv[0] value to be something
+	other than what Tcl_AfterObjCmd expects.  [Bug 1016167].
+
 2004-08-25  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* generic/tclNamesp.c (NsEnsembleImplementationCmd): Use the
@@ -8,10 +15,10 @@
 
 2004-08-24  Don Porter  <dgp@users.sourceforge.net>
 
-	* generic/tclProc.c:		The routine TclProcInterpProc was a specific
-	* generic/tclTestProcBodyObj.c:	instance of the general service already provided
-	by TclObjInvokeProc.  Removed TclProcInterpProc and TclGetInterpProc from the
-	code...
+	* generic/tclProc.c:		The routine TclProcInterpProc was a
+	* generic/tclTestProcBodyObj.c:	specific instance of the general
+	service already provided by TclObjInvokeProc.  Removed
+	TclProcInterpProc and TclGetInterpProc from the code...
 
 	* generic/tclInt.decls	...and from the internal stubs table.
 	* generic/tclIntDecls.h
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index b441ac3..f7a3d46 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTimer.c,v 1.8 2004/04/06 22:25:55 dgp Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.9 2004/08/25 22:21:34 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -765,6 +765,12 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
      */
 
     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 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 	cmdInfo.objClientData = (ClientData) assocPtr;
 	cmdInfo.deleteProc = NULL;
 	cmdInfo.deleteData = (ClientData) assocPtr;
-	Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length),
-		&cmdInfo);
+
+	Tcl_SetCommandInfoFromToken(token, &cmdInfo);
     }
 
     /*
diff --git a/tests/timer.test b/tests/timer.test
index 2eab350..46b21de 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: timer.test,v 1.8 2004/05/19 13:03:37 dkf Exp $
+# RCS: @(#) $Id: timer.test,v 1.9 2004/08/25 22:21:34 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -538,6 +538,18 @@ test timer-9.1 {AfterCleanupProc procedure} {
     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
-- 
cgit v0.12