Fix bug #3601260 and #3602706 by reverting [8aca9a8e96]. This gives time to investigate the issue without too many people being hindered by that.

1 files changed, 57 insertions, 54 deletions

diff --git a/generic/tclVar.c b/generic/tclVar.c
index 7622675..aaf1cb9 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -47,13 +47,6 @@ static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);
 #define VarHashGetValue(hPtr) \
     ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
 
-/*
- * NOTE: VarHashCreateVar increments the recount of its key argument.
- * All callers that will call Tcl_DecrRefCount on that argument must
- * call Tcl_IncrRefCount on it before passing it in.  This requirement
- * can bubble up to callers of callers .... etc.
- */
-
 static inline Var *
 VarHashCreateVar(
     TclVarHashTable *tablePtr,
@@ -388,12 +381,11 @@ TclLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
+    Tcl_Obj *part1Ptr;
     Var *varPtr;
-    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    if (createPart1) {
-	Tcl_IncrRefCount(part1Ptr);
-    }
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
 
     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
 	    createPart1, createPart2, arrayPtrPtr);
@@ -438,8 +430,6 @@ TclLookupVar(
  *	are 1. The object part1Ptr is converted to one of localVarNameType,
  *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
  *	lookup as it can.
- *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
- *	plan to DecrRefCount it.
  *
  *----------------------------------------------------------------------
  */
@@ -468,11 +458,14 @@ TclObjLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
-    Tcl_Obj *part2Ptr = NULL;
+    Tcl_Obj *part2Ptr;
     Var *resPtr;
 
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
 
     resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -847,7 +840,6 @@ TclObjLookupVarEx(
  *
  * Side effects:
  *	A new hashtable entry may be created if create is 1.
- *	Callers must Incr varNamePtr if they plan to Decr it if create is 1.
  *
  *----------------------------------------------------------------------
  */
@@ -1285,10 +1277,15 @@ Tcl_GetVar2Ex(
     int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
 				 * TCL_LEAVE_ERR_MSG bits. */
 {
-    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
 
     resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1569,8 +1566,18 @@ Tcl_SetVar2(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
-	    Tcl_NewStringObj(newValue, -1), flags);
+    register Tcl_Obj *valuePtr;
+    Tcl_Obj *varValuePtr;
+
+    /*
+     * Create an object holding the variable's new value and use Tcl_SetVar2Ex
+     * to actually set the variable.
+     */
+
+    valuePtr = Tcl_NewStringObj(newValue, -1);
+    Tcl_IncrRefCount(valuePtr);
+    varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
+    Tcl_DecrRefCount(valuePtr);
 
     if (varValuePtr == NULL) {
 	return NULL;
@@ -1630,12 +1637,15 @@ Tcl_SetVar2Ex(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
 	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
 
     resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
@@ -1668,7 +1678,6 @@ Tcl_SetVar2Ex(
  * Side effects:
  *	The value of the given variable is set. If either the array or the
  *	entry didn't exist then a new variable is created.
- *	Callers must Incr part1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -1956,7 +1965,6 @@ TclPtrSetVar(
  *	variable is created. The ref count for the returned object is _not_
  *	incremented to reflect the returned reference; if you want to keep a
  *	reference to the object you must increment its ref count yourself.
- *	Callers must Incr part1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -2039,7 +2047,8 @@ TclPtrIncrObjVar(
 				 * variable, or -1. Only used when part1Ptr is
 				 * NULL. */
 {
-    register Tcl_Obj *varValuePtr;
+    register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
+    int duplicated, code;
 
     if (TclIsVarInHash(varPtr)) {
 	VarHashRefCount(varPtr)++;
@@ -2053,33 +2062,19 @@ TclPtrIncrObjVar(
 	varValuePtr = Tcl_NewIntObj(0);
     }
     if (Tcl_IsShared(varValuePtr)) {
-	/* Copy on write */
+	duplicated = 1;
 	varValuePtr = Tcl_DuplicateObj(varValuePtr);
-	
-	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
-	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-		    varValuePtr, flags, index);
-	} else {
-	    Tcl_DecrRefCount(varValuePtr);
-	    return NULL;
-	}
     } else {
-	/* Unshared - can Incr in place */
-	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
-
-	    /*
-	     * This seems dumb to write the incremeted value into the var
-	     * after we just adjusted the value in place, but the spec for
-	     * [incr] requires that write traces fire, and making this call
-	     * is the way to make that happen.
-	     */
-
-	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-		    varValuePtr, flags, index);
-	} else {
-	    return NULL;
-	}
+	duplicated = 0;
+    }
+    code = TclIncrObj(interp, varValuePtr, incrPtr);
+    if (code == TCL_OK) {
+	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
+		part2Ptr, varValuePtr, flags, index);
+    } else if (duplicated) {
+	Tcl_DecrRefCount(varValuePtr);
     }
+    return newValuePtr;
 }
 
 /*
@@ -2148,10 +2143,13 @@ Tcl_UnsetVar2(
 				 * TCL_LEAVE_ERR_MSG. */
 {
     int result;
-    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr, *part2Ptr = NULL;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
     }
 
     /*
@@ -3320,7 +3318,6 @@ Tcl_ArrayObjCmd(
  *
  * Side effects:
  *	A variable will be created if one does not already exist.
- *	Callers must Incr arrayNameObj if they pland to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -3488,8 +3485,6 @@ TclArraySet(
  *	The variable given by myName is linked to the variable in framePtr
  *	given by otherP1 and otherP2, so that references to myName are
  *	redirected to the other variable like a symbolic link.
- *	Callers must Incr myNamePtr if they plan to Decr it.
- *	Callers must Incr otherP1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
@@ -3597,12 +3592,14 @@ TclPtrMakeUpvar(
     int index)			/* If the variable to be linked is an indexed
 				 * scalar, this is its index. Otherwise, -1 */
 {
-    Tcl_Obj *myNamePtr = NULL;
+    Tcl_Obj *myNamePtr;
     int result;
 
     if (myName) {
 	myNamePtr = Tcl_NewStringObj(myName, -1);
 	Tcl_IncrRefCount(myNamePtr);
+    } else {
+	myNamePtr = NULL;
     }
     result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
     if (myNamePtr) {
@@ -3611,8 +3608,6 @@ TclPtrMakeUpvar(
     return result;
 }
 
-/* Callers must Incr myNamePtr if they plan to Decr it. */
- 
 int
 TclPtrObjMakeUpvar(
     Tcl_Interp *interp,		/* Interpreter containing variables. Used for
@@ -4430,6 +4425,7 @@ TclDeleteNamespaceVars(
     for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
 	    varPtr = VarHashFirstVar(tablePtr, &search)) {
 	Tcl_Obj *objPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(objPtr);
 
 	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
 					 * hash. */
@@ -4693,10 +4689,15 @@ TclVarErrMsg(
 				 * e.g. "read", "set", or "unset". */
     const char *reason)		/* String describing why operation failed. */
 {
-    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
 
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
     if (part2) {
 	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2 = NULL;
     }
 
     TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
@@ -4964,6 +4965,7 @@ Tcl_FindNamespaceVar(
     Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
     Tcl_Var var;
 
+    Tcl_IncrRefCount(namePtr);
     var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
     Tcl_DecrRefCount(namePtr);
     return var;
@@ -5058,6 +5060,7 @@ ObjFindNamespaceVar(
     varPtr = NULL;
     if (simpleName != name) {
 	simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
+	Tcl_IncrRefCount(simpleNamePtr);
     } else {
 	simpleNamePtr = namePtr;
     }