* generic/tclBinary.c:

	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclIOCmd.c:
	* generic/tclLink.c:
	* generic/tclTest.c:
	* generic/tclVar.c: fix for [Bug 1334947]. The functions
	TclPtrSetVar, Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume
	the newValuePtr argument - i.e., they will free a 0-refCount
	object if they failed to set the variable. Fixed all callers in
	the core.

11 files changed, 61 insertions, 83 deletions

diff --git a/ChangeLog b/ChangeLog
index ffae771..4c33124 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2005-11-04  Miguel Sofer <msofer@users.sf.net>
+
+	* generic/tclBinary.c:
+	* generic/tclCmdAH.c:
+	* generic/tclCmdIL.c:
+	* generic/tclCmdMZ.c:
+	* generic/tclDictObj.c:
+	* generic/tclExecute.c:
+	* generic/tclIOCmd.c:
+	* generic/tclLink.c:
+	* generic/tclTest.c:
+	* generic/tclVar.c: fix for [Bug 1334947]. The functions
+	TclPtrSetVar, Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume
+	the newValuePtr argument - i.e., they will free a 0-refCount
+	object if they failed to set the variable. Fixed all callers in
+	the core. 
+
 2005-11-04  Kevin Kenny  <kennykb@acm.org>
 
 	* generic/tclGetDate.y: Added abbreviations for the Korean
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index a5c2842..c20f4df 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -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: tclBinary.c,v 1.26 2005/09/27 15:20:35 dkf Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.27 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1085,7 +1085,6 @@ Tcl_BinaryObjCmd(
 		arg++;
 		if (resultPtr == NULL) {
 		    DeleteScanNumberCache(numberCachePtr);
-		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
 		    return TCL_ERROR;
 		}
 		offset += count;
@@ -1140,7 +1139,6 @@ Tcl_BinaryObjCmd(
 		arg++;
 		if (resultPtr == NULL) {
 		    DeleteScanNumberCache(numberCachePtr);
-		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
 		    return TCL_ERROR;
 		}
 		offset += (count + 7 ) / 8;
@@ -1197,7 +1195,6 @@ Tcl_BinaryObjCmd(
 		arg++;
 		if (resultPtr == NULL) {
 		    DeleteScanNumberCache(numberCachePtr);
-		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
 		    return TCL_ERROR;
 		}
 		offset += (count + 1) / 2;
@@ -1267,7 +1264,6 @@ Tcl_BinaryObjCmd(
 		arg++;
 		if (resultPtr == NULL) {
 		    DeleteScanNumberCache(numberCachePtr);
-		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
 		    return TCL_ERROR;
 		}
 		break;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 18e7f01..2811626 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -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: tclCmdAH.c,v 1.69 2005/10/08 14:42:44 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.70 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -267,7 +267,6 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
 	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
 	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
 		options, 0)) {
-	    Tcl_DecrRefCount(options);
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp,
 		    "couldn't save return options in variable", NULL);
@@ -1485,7 +1484,6 @@ StoreStatData(interp, varName, statPtr)
     value = (object); \
     if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
 	Tcl_DecrRefCount(field); \
-	Tcl_DecrRefCount(value); \
 	return TCL_ERROR; \
     }
 
@@ -1805,20 +1803,15 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
 	    for (v=0 ; v<varcList[i] ; v++) {
 		int k = index[i]++;
 		Tcl_Obj *valuePtr, *varValuePtr;
-		int isEmptyObj = 0;
 
 		if (k < argcList[i]) {
 		    valuePtr = argvList[i][k];
 		} else {
 		    valuePtr = Tcl_NewObj(); /* empty string */
-		    isEmptyObj = 1;
 		}
 		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
 			NULL, valuePtr, 0);
 		if (varValuePtr == NULL) {
-		    if (isEmptyObj) {
-			Tcl_DecrRefCount(valuePtr);
-		    }
 		    Tcl_ResetResult(interp);
 		    Tcl_AppendResult(interp, "couldn't set loop variable: \"",
 			    TclGetString(varvList[i][v]), "\"", (char *) NULL);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 464ac42..12c3e77 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.83 2005/10/19 18:39:58 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.84 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1012,7 +1012,6 @@ InfoDefaultCmd(dummy, interp, objc, objv)
 		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
 			nullObjPtr, 0);
 		if (valueObjPtr == NULL) {
-		    Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
 		    goto defStoreError;
 		}
 		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
@@ -2260,7 +2259,8 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
     Tcl_Obj **listObjv;		/* The contents of the list. */
     int listObjc;		/* The length of the list. */
     int i;
-
+    Tcl_Obj *resPtr;
+    
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list varname ?varname ...?");
 	return TCL_ERROR;
@@ -2294,15 +2294,15 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
 	 */
 
 	Tcl_IncrRefCount(valueObj);
-	if (Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
-		TCL_LEAVE_ERR_MSG) == NULL) {
-	    Tcl_DecrRefCount(valueObj);
+	resPtr = Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
+		TCL_LEAVE_ERR_MSG);
+	TclDecrRefCount(valueObj);
+	if (resPtr == NULL) {
 	    if (emptyObj != NULL) {
 		Tcl_DecrRefCount(emptyObj);
 	    }
 	    return TCL_ERROR;
 	}
-	Tcl_DecrRefCount(valueObj);
     }
     if (emptyObj != NULL) {
 	Tcl_DecrRefCount(emptyObj);
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index a016124..1472f43 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.132 2005/10/08 14:42:44 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.133 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -367,7 +367,6 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 		Tcl_Obj *valuePtr;
 		valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
 		if (valuePtr == NULL) {
-		    Tcl_DecrRefCount(newPtr);
 		    Tcl_AppendResult(interp, "couldn't set variable \"",
 			    TclGetString(objv[i]), "\"", (char *) NULL);
 		    return TCL_ERROR;
@@ -2730,7 +2729,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 		TclNewObj(emptyObj);
 		if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj,
 			TCL_LEAVE_ERR_MSG) == NULL) {
-		    Tcl_DecrRefCount(emptyObj);
 		    return TCL_ERROR;
 		}
 	    }
@@ -2740,9 +2738,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 		}
 		if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj,
 			TCL_LEAVE_ERR_MSG) == NULL) {
-		    if (indexVarObj == NULL) {
-			Tcl_DecrRefCount(emptyObj);
-		    }
 		    return TCL_ERROR;
 		}
 	    }
@@ -2829,8 +2824,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	if (indexVarObj != NULL) {
 	    if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
 		    TCL_LEAVE_ERR_MSG) == NULL) {
-		Tcl_DecrRefCount(indicesObj);
-
 		/*
 		 * Careful! Check to see if we have allocated the list of
 		 * matched strings; if so (but there was an error assigning
@@ -2848,8 +2841,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	if (matchVarObj != NULL) {
 	    if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj,
 		    TCL_LEAVE_ERR_MSG) == NULL) {
-		Tcl_DecrRefCount(matchesObj);
-
 		/*
 		 * Unlike above, if indicesObj is non-NULL at this point, it
 		 * will have been written to a variable already and will hence
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index be0a2ef..12907db 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.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: tclDictObj.c,v 1.38 2005/11/01 15:30:52 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.39 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1963,18 +1963,17 @@ DictIncrCmd(
 	    Tcl_DecrRefCount(incrPtr);
 	}
     }
-    Tcl_IncrRefCount(dictPtr);
     if (code == TCL_OK) {
 	Tcl_InvalidateStringRep(dictPtr);
 	valuePtr = Tcl_ObjSetVar2(interp, objv[2], NULL,
 		dictPtr, TCL_LEAVE_ERR_MSG);
 	if (valuePtr == NULL) {
 	    code = TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, valuePtr);
 	}
-    }
-    Tcl_DecrRefCount(dictPtr);
-    if (code == TCL_OK) {
-	Tcl_SetObjResult(interp, valuePtr);
+    } else if (dictPtr->refCount == 0) {
+	Tcl_DecrRefCount(dictPtr);
     }
     return code;
 }
@@ -2056,10 +2055,8 @@ DictLappendCmd(
 	Tcl_InvalidateStringRep(dictPtr);
     }
 
-    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
-    TclDecrRefCount(dictPtr);
     if (resultPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -2129,10 +2126,8 @@ DictAppendCmd(
 
     Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
 
-    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
-    TclDecrRefCount(dictPtr);
     if (resultPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -2309,10 +2304,8 @@ DictSetCmd(
 	return TCL_ERROR;
     }
 
-    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
-    TclDecrRefCount(dictPtr);
     if (resultPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -2369,10 +2362,8 @@ DictUnsetCmd(
 	return TCL_ERROR;
     }
 
-    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
-    TclDecrRefCount(dictPtr);
     if (resultPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -2653,7 +2644,7 @@ DictUpdateCmd(
     Tcl_Obj *CONST *objv)
 {
     Tcl_Obj *dictPtr, *objPtr;
-    int i, result, dummy, allocdict = 0;
+    int i, result, dummy;
     Tcl_InterpState state;
 
     if (objc < 6 || objc & 1) {
@@ -2716,7 +2707,6 @@ DictUpdateCmd(
 
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
-	allocdict = 1;
     }
 
     /*
@@ -2741,9 +2731,6 @@ DictUpdateCmd(
     if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG) == NULL) {
 	Tcl_DiscardInterpState(state);
-	if (allocdict) {
-	    TclDecrRefCount(dictPtr);
-	}
 	return TCL_ERROR;
     }
 
@@ -2921,9 +2908,6 @@ DictWithCmd(
 
     if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG) == NULL) {
-	if (allocdict) {
-	    TclDecrRefCount(dictPtr);
-	}
 	Tcl_DiscardInterpState(state);
 	return TCL_ERROR;
     }
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 3f47527..7bfb787 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.219 2005/11/02 11:55:47 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.220 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -5503,10 +5503,7 @@ TclExecuteByteCode(
 
 		valIndex = (iterNum * numVars);
 		for (j = 0;  j < numVars;  j++) {
-		    int setEmptyStr = 0;
-
 		    if (valIndex >= listLen) {
-			setEmptyStr = 1;
 			TclNewObj(valuePtr);
 		    } else {
 			valuePtr = elements[valIndex];
@@ -5538,9 +5535,6 @@ TclExecuteByteCode(
 			if (value2Ptr == NULL) {
 			    TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
 				    opnd, varIndex), Tcl_GetObjResult(interp));
-			    if (setEmptyStr) {
-				TclDecrRefCount(valuePtr);
-			    }
 			    result = TCL_ERROR;
 			    goto checkForCatch;
 			}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index b6232ac..276ccf5 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.32 2005/11/01 15:30:52 dkf Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.33 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -289,7 +289,6 @@ Tcl_GetsObjCmd(
     if (objc == 3) {
 	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
 		TCL_LEAVE_ERR_MSG) == NULL) {
-	    Tcl_DecrRefCount(linePtr);
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2ab72ff..0dcb995 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -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: tclLink.c,v 1.13 2005/10/08 14:42:45 dgp Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.14 2005/11/04 22:38:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -118,7 +118,6 @@ Tcl_LinkVar(interp, varName, addr, type)
     if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
 	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	Tcl_DecrRefCount(objPtr);
 	ckfree((char *) linkPtr);
 	return TCL_ERROR;
     }
diff --git a/generic/tclTest.c b/generic/tclTest.c
index d4b60a3..dc5269c 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.98 2005/11/02 15:59:48 dkf Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.99 2005/11/04 22:38:38 msofer Exp $
  */
 
 #define TCL_TEST
@@ -3843,7 +3843,6 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 	}
 	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
 	if (valuePtr == NULL) {
-	    Tcl_DecrRefCount(newPtr);
 	    Tcl_AppendResult(interp, "couldn't set variable \"",
 		    Tcl_GetString(varPtr), "\"", NULL);
 	    return TCL_ERROR;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index d8fb817..d180c12 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.114 2005/11/04 02:13:41 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.115 2005/11/04 22:38:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1390,10 +1390,7 @@ Tcl_SetVar2(
      */
 
     valuePtr = Tcl_NewStringObj(newValue, -1);
-    Tcl_IncrRefCount(valuePtr);
-
     varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
-    TclDecrRefCount(valuePtr); /* done with the object */
 
     if (varValuePtr == NULL) {
 	return NULL;
@@ -1458,6 +1455,9 @@ Tcl_SetVar2Ex(
     varPtr = TclLookupVar(interp, part1, part2, flags, "set",
 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
+	if (newValuePtr->refCount == 0) {
+	    Tcl_DecrRefCount(newValuePtr);
+	}
 	return NULL;
     }
 
@@ -1514,6 +1514,9 @@ Tcl_ObjSetVar2(
     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
+	if (newValuePtr->refCount == 0) {
+	    Tcl_DecrRefCount(newValuePtr);
+	}
 	return NULL;
     }
 
@@ -1583,7 +1586,7 @@ TclPtrSetVar(
 		TclVarErrMsg(interp, part1, part2, "set", danglingVar);
 	    }
 	}
-	return NULL;
+	goto earlyError;
     }
 
     /*
@@ -1594,7 +1597,7 @@ TclPtrSetVar(
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclVarErrMsg(interp, part1, part2, "set", isArray);
 	}
-	return NULL;
+	goto earlyError;
     }
 
     /*
@@ -1606,7 +1609,7 @@ TclPtrSetVar(
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
 	if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
 		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
-	    return NULL;
+	    goto earlyError;
 	}
     }
 
@@ -1641,7 +1644,7 @@ TclPtrSetVar(
 	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
 		    newValuePtr);
 	    if (result != TCL_OK) {
-		return NULL;
+		goto earlyError;
 	    }
 	} else {				/* append string */
 	    /*
@@ -1719,6 +1722,12 @@ TclPtrSetVar(
 	TclCleanupVar(varPtr, arrayPtr);
     }
     return resultPtr;
+
+  earlyError:
+    if (newValuePtr->refCount == 0) {
+	Tcl_DecrRefCount(newValuePtr);
+    }
+    goto cleanup;    
 }
 
 /*
@@ -1827,7 +1836,7 @@ TclPtrIncrObjVar(
 				 * TCL_LEAVE_ERR_MSG. */
 {
     register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
-    int code;
+    int duplicated, code;
 
     varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
     if (varValuePtr == NULL) {
@@ -1836,15 +1845,18 @@ TclPtrIncrObjVar(
 	return NULL;
     }
     if (Tcl_IsShared(varValuePtr)) {
+	duplicated = 1;
 	varValuePtr = Tcl_DuplicateObj(varValuePtr);
+    } else {
+	duplicated = 0;
     }
     code = TclIncrObj(interp, varValuePtr, incrPtr);
-    Tcl_IncrRefCount(varValuePtr);
     if (code == TCL_OK) {
 	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
 		varValuePtr, flags);
+    } else if (duplicated) {
+	Tcl_DecrRefCount(varValuePtr);
     }
-    Tcl_DecrRefCount(varValuePtr);
     return newValuePtr;
 }
 
@@ -2331,7 +2343,7 @@ Tcl_LappendObjCmd(
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     Tcl_Obj *varValuePtr, *newValuePtr;
-    int numElems, createdNewObj, createVar;
+    int numElems, createdNewObj;
     Var *varPtr, *arrayPtr;
     char *part1;
     int result;
@@ -2352,7 +2364,6 @@ Tcl_LappendObjCmd(
 	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
 		    TCL_LEAVE_ERR_MSG);
 	    if (newValuePtr == NULL) {
-		TclDecrRefCount(varValuePtr); /* free unneeded object */
 		return TCL_ERROR;
 	    }
 	}
@@ -2368,7 +2379,6 @@ Tcl_LappendObjCmd(
 	 */
 
 	createdNewObj = 0;
-	createVar = 1;
 
 	/*
 	 * Use the TCL_TRACE_READS flag to ensure that if we have an array
@@ -2403,7 +2413,6 @@ Tcl_LappendObjCmd(
 	     * create it with Tcl_ObjSetVar2 below.
 	     */
 
-	    createVar = (TclIsVarUndefined(varPtr));
 	    TclNewObj(varValuePtr);
 	    createdNewObj = 1;
 	} else if (Tcl_IsShared(varValuePtr)) {
@@ -2432,9 +2441,6 @@ Tcl_LappendObjCmd(
 	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
 		varValuePtr, TCL_LEAVE_ERR_MSG);
 	if (newValuePtr == NULL) {
-	    if (createdNewObj && !createVar) {
-		TclDecrRefCount(varValuePtr); /* free unneeded obj */
-	    }
 	    return TCL_ERROR;
 	}
     }