From a371489bc6ceddc40588b7fc34595e01989d633d Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Fri, 4 Nov 2005 22:38:38 +0000 Subject: * 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. --- ChangeLog | 17 +++++++++++++++++ generic/tclBinary.c | 6 +----- generic/tclCmdAH.c | 9 +-------- generic/tclCmdIL.c | 14 +++++++------- generic/tclCmdMZ.c | 11 +---------- generic/tclDictObj.c | 28 ++++++---------------------- generic/tclExecute.c | 8 +------- generic/tclIOCmd.c | 3 +-- generic/tclLink.c | 3 +-- generic/tclTest.c | 3 +-- generic/tclVar.c | 42 ++++++++++++++++++++++++------------------ 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 + + * 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 * 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 ; vrefCount == 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; } } -- cgit v0.12