diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBinary.c | 6 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 9 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 14 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 11 | ||||
-rw-r--r-- | generic/tclDictObj.c | 28 | ||||
-rw-r--r-- | generic/tclExecute.c | 8 | ||||
-rw-r--r-- | generic/tclIOCmd.c | 3 | ||||
-rw-r--r-- | generic/tclLink.c | 3 | ||||
-rw-r--r-- | generic/tclTest.c | 3 | ||||
-rw-r--r-- | generic/tclVar.c | 42 |
10 files changed, 44 insertions, 83 deletions
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; } } |