* generic/tclInt.h:

	* generic/tclNamesp.c:
	* generic/tclVar.c:
	* tests/trace.test: fix for [Bugs 1338280/1337229]; changed to use
	the same approach as the 8.4 patch in the ticket (i.e., removed
	the patch committed on 2005-31-10).

5 files changed, 215 insertions, 84 deletions

diff --git a/ChangeLog b/ChangeLog
index 212aa4c..d8e46ca 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2005-11-04  Miguel Sofer <msofer@users.sf.net>
+
+	* generic/tclInt.h:
+	* generic/tclNamesp.c: 
+	* generic/tclVar.c: 
+	* tests/trace.test: fix for [Bugs 1338280/1337229]; changed to use
+	the same approach as the 8.4 patch in the ticket (i.e., removed
+	the patch committed on 2005-31-10).
+	
 2005-11-03  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
 	* win/tclWin32Dll.c:   Applied patch #1256872 to provide unicode
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 32ef3b0..0a6fa66 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.255 2005/10/10 19:52:44 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.256 2005/11/04 02:13:41 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2019,6 +2019,7 @@ MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
 MODULE_SCOPE void	TclCleanupLiteralTable(Tcl_Interp* interp,
 			    LiteralTable* tablePtr);
 MODULE_SCOPE int	TclDoubleDigits(char* buf, double value, int* signum);
+MODULE_SCOPE void       TclDeleteNamespaceVars(Namespace *nsPtr);
 MODULE_SCOPE void	TclExpandTokenArray(Tcl_Parse *parsePtr);
 MODULE_SCOPE int	TclFileAttrsCmd(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 456f335..299b1ac 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.85 2005/10/31 19:54:56 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.86 2005/11/04 02:13:41 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -958,7 +958,7 @@ Tcl_DeleteNamespace(namespacePtr)
 	     * one last time.
 	     */
 
-	    TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
+	    TclDeleteNamespaceVars(nsPtr);
 
 	    Tcl_DeleteHashTable(&nsPtr->childTable);
 	    Tcl_DeleteHashTable(&nsPtr->cmdTable);
@@ -1019,6 +1019,15 @@ TclTeardownNamespace(nsPtr)
     int i;
 
     /*
+     * Start by destroying the namespace's variable table, since variables
+     * might trigger traces. Variable table should be cleared but not freed!
+     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
+     */
+
+    TclDeleteNamespaceVars(nsPtr);
+    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+
+    /*
      * Delete all commands in this namespace. Be careful when traversing the
      * hash table: when each command is deleted, it removes itself from the
      * command table.
@@ -1049,15 +1058,6 @@ TclTeardownNamespace(nsPtr)
     nsPtr->parentPtr = NULL;
 
     /*
-     * Destroy the namespace's variable table
-     * Variable table should be cleared but not freed!
-     * TclDeleteVars frees it, so we reinitialize it afterwards.
-     */
-
-    TclDeleteVars(iPtr, &nsPtr->varTable);
-    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
-
-    /*
      * Delete the namespace path if one is installed.
      */
 
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 08b00aa..d8fb817 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.113 2005/11/02 11:55:47 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.114 2005/11/04 02:13:41 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -52,6 +52,8 @@ static int		ObjMakeUpvar(Tcl_Interp *interp,
 static Var *		NewVar(void);
 static ArraySearch *	ParseSearchId(Tcl_Interp *interp, CONST Var *varPtr,
 			    CONST char *varName, Tcl_Obj *handleObj);
+static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr,
+	                     CONST char *part1, CONST char *part2, int flags);
 static int		SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
 /*
@@ -1953,12 +1955,9 @@ TclObjUnsetVar2(
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Var dummyVar;
-    Var *varPtr, *dummyVarPtr;
+    Var *varPtr;
     Interp *iPtr = (Interp *) interp;
     Var *arrayPtr;
-    ActiveVarTrace *activePtr;
-    Tcl_Obj *objPtr;
     int result;
     char *part1;
 
@@ -1968,23 +1967,120 @@ TclObjUnsetVar2(
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
-
+ 
     result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
 
+    /*
+     * Keep the variable alive until we're done with it. We used to
+     * increase/decrease the refCount for each operation, making it
+     * hard to find [Bug 735335] - caused by unsetting the variable
+     * whose value was the variable's name.
+     */
+    
+    varPtr->refCount++;
+
+    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags);
+
+    /*
+     * It's an error to unset an undefined variable.
+     */
+	
+    if (result != TCL_OK) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
+	    TclVarErrMsg(interp, part1, part2, "unset", 
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
+	}
+    }
+
+#if ENABLE_NS_VARNAME_CACHING
+    /*
+     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType 
+     * keeping a reference. This removes some additional exteriorisations of
+     * [Bug 736729], but may be a good thing independently of the bug.
+     */
+
+    if (part1Ptr->typePtr == &tclNsVarNameType) {
+	TclFreeIntRep(part1Ptr);
+	part1Ptr->typePtr = NULL;
+    }
+#endif
+    
+    /*
+     * Finally, if the variable is truly not in use then free up its Var
+     * structure and remove it from its hash table, if any. The ref count of
+     * its value object, if any, was decremented above.
+     */
+
+    varPtr->refCount--;
+    TclCleanupVar(varPtr, arrayPtr);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnsetVarStruct --
+ *
+ *	Unset and delete a variable. This does the internal work for
+ *	TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each
+ *	variable to be unset and deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the arguments indicate a local or global variable in iPtr, it is
+ *      unset and deleted.   
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnsetVarStruct(
+    Var *varPtr,
+    Var *arrayPtr,
+    Interp *iPtr,
+    CONST char *part1,
+    CONST char *part2,
+    int flags)
+{
+    Var dummyVar;
+    Var *dummyVarPtr;
+    ActiveVarTrace *activePtr;
+
     if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
 	DeleteSearches(arrayPtr);
     }
 
     /*
+     * For global/upvar variables referenced in procedures, decrement
+     * the reference count on the variable referred to, and free
+     * the referenced variable if it's no longer needed. 
+     */
+
+    if (TclIsVarLink(varPtr)) {
+	Var *linkPtr = varPtr->value.linkPtr;
+	linkPtr->refCount--;
+	if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
+		&& (linkPtr->tracePtr == NULL)
+		&& (linkPtr->flags & VAR_IN_HASHTABLE)) {
+	    if (linkPtr->hPtr != NULL) {
+		Tcl_DeleteHashEntry(linkPtr->hPtr);
+	    }
+	    ckfree((char *) linkPtr);
+	}
+    }
+
+    /*
      * The code below is tricky, because of the possibility that a trace
      * function might try to access a variable being deleted. To handle this
      * situation gracefully, do things in three steps:
      * 1. Copy the contents of the variable to a dummy variable structure, and
-     *    mark the original Var structure as undefined.
+     *    mark the original Var structure as undefined. 
      * 2. Invoke traces and clean up the variable, using the dummy copy.
      * 3. If at the end of this the original variable is still undefined and
-     *    has no outstanding references, then delete * it (but it could have
-     *    gotten recreated by a trace).
+     *    has no outstanding references, then delete it (but it could have
+     *    gotten recreated by a trace). 
      */
 
     dummyVar = *varPtr;
@@ -1995,22 +2091,13 @@ TclObjUnsetVar2(
     varPtr->searchPtr = NULL;
 
     /*
-     * Keep the variable alive until we're done with it. We used to
-     * increase/decrease the refCount for each operation, making it hard to
-     * find [Bug 735335] - caused by unsetting the variable whose value was
-     * the variable's name.
-     */
-
-    varPtr->refCount++;
-
-    /*
-     * Call trace functions for the variable being deleted. Then delete its
+     * Call trace procedures for the variable being deleted. Then delete its
      * traces. Be sure to abort any other traces for the variable that are
-     * still pending. Special tricks:
+     * still pending. Special tricks: 
      * 1. We need to increment varPtr's refCount around this: TclCallVarTraces
      *    will use dummyVar so it won't increment varPtr's refCount itself.
-     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call
-     *    unset traces even if other traces are pending.
+     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to
+     *    call unset traces even if other traces are pending.
      */
 
     if ((dummyVar.tracePtr != NULL)
@@ -2024,8 +2111,8 @@ TclObjUnsetVar2(
 	    dummyVar.tracePtr = tracePtr->nextPtr;
 	    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
 	}
-	for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
-		activePtr = activePtr->nextPtr) {
+	for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
+	     activePtr = activePtr->nextPtr) {
 	    if (activePtr->varPtr == varPtr) {
 		activePtr->nextTracePtr = NULL;
 	    }
@@ -2036,82 +2123,45 @@ TclObjUnsetVar2(
      * If the variable is an array, delete all of its elements. This must be
      * done after calling the traces on the array, above (that's the way
      * traces are defined). If it is a scalar, "discard" its object (decrement
-     * the ref count of its object, if any).
+     * the ref count of its object, if any). 
      */
 
     dummyVarPtr = &dummyVar;
     if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
 	/*
 	 * Deleting the elements of the array may cause traces to be fired on
-	 * those elements. Before deleting them, bump the reference count of
+	 * those elements.  Before deleting them, bump the reference count of
 	 * the array, so that if those trace procs make a global or upvar link
 	 * to the array, the array is not deleted when the call stack gets
 	 * popped (we will delete the array ourselves later in this function).
 	 *
-	 * Bumping the count can lead to the odd situation that elements of
-	 * the array are being deleted when the array still exists, but since
-	 * the array is about to be removed anyway, that shouldn't really
-	 * matter.
+	 * Bumping the count can lead to the odd situation that elements of the
+	 * array are being deleted when the array still exists, but since the
+	 * array is about to be removed anyway, that shouldn't really matter.
 	 */
-
 	DeleteArray(iPtr, part1, dummyVarPtr,
-		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) 
 		| TCL_TRACE_UNSETS);
-
 	/*
 	 * Decr ref count
 	 */
     }
     if (TclIsVarScalar(dummyVarPtr)
 	    && (dummyVarPtr->value.objPtr != NULL)) {
-	objPtr = dummyVarPtr->value.objPtr;
+	Tcl_Obj *objPtr = dummyVarPtr->value.objPtr;
 	TclDecrRefCount(objPtr);
 	dummyVarPtr->value.objPtr = NULL;
     }
 
     /*
-     * If the variable was a namespace variable, decrement its reference
-     * count.
+     * If the variable was a namespace variable, decrement its reference count.
      */
-
+    
     if (TclIsVarNamespaceVar(varPtr)) {
 	TclClearVarNamespaceVar(varPtr);
 	varPtr->refCount--;
     }
 
-    /*
-     * It's an error to unset an undefined variable.
-     */
-
-    if (result != TCL_OK) {
-	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclVarErrMsg(interp, part1, part2, "unset",
-		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
-	}
-    }
-
-#if ENABLE_NS_VARNAME_CACHING
-    /*
-     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
-     * keeping a reference. This removes some additional exteriorisations of
-     * [Bug 736729], but may be a good thing independently of the bug.
-     */
-
-    if (part1Ptr->typePtr == &tclNsVarNameType) {
-	TclFreeIntRep(part1Ptr);
-	part1Ptr->typePtr = NULL;
-    }
-#endif
-
-    /*
-     * Finally, if the variable is truly not in use then free up its Var
-     * structure and remove it from its hash table, if any. The ref count of
-     * its value object, if any, was decremented above.
-     */
-
-    varPtr->refCount--;
-    TclCleanupVar(varPtr, arrayPtr);
-    return result;
 }
 
 /*
@@ -3929,6 +3979,77 @@ DeleteSearches(
 /*
  *----------------------------------------------------------------------
  *
+ * TclDeleteNamespaceVars --
+ *
+ *	This procedure is called to recycle all the storage space
+ *	associated with a namespace's table of variables. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteNamespaceVars(
+    Namespace *nsPtr)
+{
+    Tcl_HashTable *tablePtr = &nsPtr->varTable;
+    Tcl_Interp *interp = nsPtr->interp;
+    Interp *iPtr = (Interp *)interp;
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
+    int flags = 0;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+
+    /*
+     * Determine what flags to pass to the trace callback procedures.
+     */
+
+    if (nsPtr == iPtr->globalNsPtr) {
+	flags = TCL_GLOBAL_ONLY;
+    } else if (nsPtr == currNsPtr) {
+	flags = TCL_NAMESPACE_ONLY;
+    }
+    if (Tcl_InterpDeleted(interp)) {
+	flags |= TCL_INTERP_DESTROYED;
+    }
+
+    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
+	 hPtr = Tcl_FirstHashEntry(tablePtr, &search)) {
+	register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr);
+	Tcl_Obj *objPtr = Tcl_NewObj();
+	varPtr->refCount++;	/* Make sure we get to remove from hash */
+	Tcl_IncrRefCount(objPtr); 
+	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
+	UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags);
+	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
+	varPtr->refCount--;
+
+	/* Remove the variable from the table and force it undefined
+	 * in case an unset trace brought it back from the dead */
+	Tcl_DeleteHashEntry(hPtr);
+	varPtr->hPtr = NULL;
+	TclSetVarUndefined(varPtr);
+	TclSetVarScalar(varPtr);
+	while (varPtr->tracePtr != NULL) {
+	    VarTrace *tracePtr = varPtr->tracePtr;
+	    varPtr->tracePtr = tracePtr->nextPtr;
+	    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+	}
+	TclCleanupVar(varPtr, NULL);
+    }
+    Tcl_DeleteHashTable(tablePtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclDeleteVars --
  *
  *	This function is called to recycle all the storage space associated
diff --git a/tests/trace.test b/tests/trace.test
index 224f698..29c6a9a 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: trace.test,v 1.42 2005/10/31 19:54:56 msofer Exp $
+# RCS: @(#) $Id: trace.test,v 1.43 2005/11/04 02:13:41 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1179,7 +1179,7 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
     namespace delete ::ref
     rename doTrace {}
     set info
-} 1010
+} 1110
 
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.