From a41f586cbbb2bccd146270743f2479e007b12cb9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 12 May 2003 22:35:38 +0000
Subject:         * generic/tclInterp.c: (AliasObjCmd):   Added refCounting of
 the words         * tests/interp.test (interp-33.1):      of the target of an
 interp         alias during its execution.  Also added test. [Bug 730244].

---
 ChangeLog           |  4 ++++
 generic/tclInterp.c | 10 ++++++++--
 tests/interp.test   | 11 ++++++++++-
 3 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ebb70a9..f5ee8f4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2003-05-12  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclInterp.c: (AliasObjCmd):	Added refCounting of the words
+	* tests/interp.test (interp-33.1):	of the target of an interp
+	alias during its execution.  Also added test. [Bug 730244].
+
         * generic/tclBasic.c (TclInvokeObjectCommand):  objv[argc] is no
         longer set to NULL (Tcl_CreateObjCommand docs already say that it
         should not be accessed).
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 8d49791..851123d 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.20.2.1 2003/03/12 17:51:33 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.20.2.2 2003/05/12 22:35:40 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1446,7 +1446,7 @@ AliasObjCmd(clientData, interp, objc, objv)
 #define ALIAS_CMDV_PREALLOC 10
     Tcl_Interp *targetInterp;	
     Alias *aliasPtr;		
-    int result, prefc, cmdc;
+    int result, prefc, cmdc, i;
     Tcl_Obj **prefv, **cmdv;
     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
     aliasPtr = (Alias *) clientData;
@@ -1474,6 +1474,9 @@ AliasObjCmd(clientData, interp, objc, objv)
 
     Tcl_ResetResult(targetInterp);
 
+    for (i=0; i<cmdc; i++) {
+	Tcl_IncrRefCount(cmdv[i]);
+    }
     if (targetInterp != interp) {
 	Tcl_Preserve((ClientData) targetInterp);
 	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
@@ -1482,6 +1485,9 @@ AliasObjCmd(clientData, interp, objc, objv)
     } else {
 	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
     }
+    for (i=0; i<cmdc; i++) {
+	Tcl_DecrRefCount(cmdv[i]);
+    }
 
     if (cmdv != cmdArr) {
 	ckfree((char *) cmdv);
diff --git a/tests/interp.test b/tests/interp.test
index a9b9e65..f29aec6 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.19.2.2 2003/05/05 16:52:33 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.19.2.3 2003/05/12 22:35:40 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -2919,6 +2919,15 @@ test interp-32.1 { parent's working directory should
              "\{$parent\} != \{$child\}"}
 } 1
 
+test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
+    # This test will panic if Bug 730244 is not fixed.
+    interp create i
+    proc test args {return $args}
+    trace add execution test enter {interp alias i alias {} ;#}
+    interp alias i alias {} test this
+    i eval alias 
+} this
+
 # cleanup
 foreach i [interp slaves] {
   interp delete $i
-- 
cgit v0.12