diff options
| -rw-r--r-- | generic/tclVar.c | 111 |
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; } |