summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-01-31 09:49:50 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-01-31 09:49:50 (GMT)
commit3cd0a536490310cda2013a4315da05461a0fc8c6 (patch)
treed8a0f83fb54d17254aef8fe6c44924dbf5bf9aea /generic
parent31f3f5ff6333217316c5da442a0194085211dfe1 (diff)
parent9df34dd7c3b9ed251e319e644d916a7c0898230e (diff)
downloadtcl-3cd0a536490310cda2013a4315da05461a0fc8c6.zip
tcl-3cd0a536490310cda2013a4315da05461a0fc8c6.tar.gz
tcl-3cd0a536490310cda2013a4315da05461a0fc8c6.tar.bz2
Fix bug #3601260 and #3602706 by reverting [8aca9a8e96]. This gives time to investigate the issue without too many people being hindered by that.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclVar.c111
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;
}