summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:42:41 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:42:41 (GMT)
commitc1534c208e4eee03061c52b2d7de3ded03f8de37 (patch)
tree6e29718539a83cd56321eb262b49a848eb9b3b31 /generic
parentf231dc527e35148e1fb38301a10ccb8614fd1c72 (diff)
downloadtcl-c1534c208e4eee03061c52b2d7de3ded03f8de37.zip
tcl-c1534c208e4eee03061c52b2d7de3ded03f8de37.tar.gz
tcl-c1534c208e4eee03061c52b2d7de3ded03f8de37.tar.bz2
Fix [Bug 2939073]: dangling ref when an unset trace triggered by [array unset]
hits the next element to be deleted.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclVar.c79
1 files changed, 59 insertions, 20 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 969cc17..775c864 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.160.2.6 2009/10/17 22:35:58 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.160.2.7 2010/02/02 00:42:41 dkf Exp $
*/
#include "tclInt.h"
@@ -3170,11 +3170,7 @@ Tcl_ArrayObjCmd(
return TCL_ERROR;
}
return TclArraySet(interp, objv[2], objv[3]);
- case ARRAY_UNSET: {
- Tcl_HashSearch search;
- Var *varPtr2;
- char *pattern = NULL;
-
+ case ARRAY_UNSET:
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
return TCL_ERROR;
@@ -3187,11 +3183,16 @@ Tcl_ArrayObjCmd(
* When no pattern is given, just unset the whole array.
*/
- if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0) != TCL_OK) {
- return TCL_ERROR;
- }
+ return TclObjUnsetVar2(interp, varNamePtr, NULL, 0);
} else {
- pattern = TclGetString(objv[3]);
+ Tcl_HashSearch search;
+ Var *varPtr2, *protectedVarPtr;
+ const char *pattern = TclGetString(objv[3]);
+
+ /*
+ * With a trivial pattern, we can just unset.
+ */
+
if (TclMatchIsTrivial(pattern)) {
varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
if (varPtr2 != NULL && !TclIsVarUndefined(varPtr2)) {
@@ -3199,23 +3200,61 @@ Tcl_ArrayObjCmd(
}
return TCL_OK;
}
+
+ /*
+ * Non-trivial case (well, deeply tricky really). We peek inside
+ * the hash iterator in order to allow us to guarantee that the
+ * following element in the array will not be scrubbed until we
+ * have dealt with it. This stops the overall iterator from ending
+ * up pointing into deallocated memory. [Bug 2939073]
+ */
+
+ protectedVarPtr = NULL;
for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
- Tcl_Obj *namePtr;
+ /*
+ * Drop the extra ref immediately. We don't need to free it at
+ * this point though; we'll be unsetting it if necessary soon.
+ */
- if (TclIsVarUndefined(varPtr2)) {
- continue;
+ if (varPtr2 == protectedVarPtr) {
+ VarHashRefCount(varPtr2)--;
+ }
+
+ /*
+ * Guard the next item in the search chain by incrementing its
+ * refcount. This guarantees that the hash table iterator
+ * won't be dangling on the next time through the loop.
+ */
+
+ if (search.nextEntryPtr != NULL) {
+ protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
+ VarHashRefCount(protectedVarPtr)++;
+ } else {
+ protectedVarPtr = NULL;
}
- namePtr = VarHashGetKey(varPtr2);
- if (Tcl_StringMatch(TclGetString(namePtr), pattern) &&
- TclObjUnsetVar2(interp, varNamePtr, namePtr,
- 0) != TCL_OK) {
- return TCL_ERROR;
+
+ if (!TclIsVarUndefined(varPtr2)) {
+ Tcl_Obj *namePtr = VarHashGetKey(varPtr2);
+
+ if (Tcl_StringMatch(TclGetString(namePtr), pattern)
+ && TclObjUnsetVar2(interp, varNamePtr, namePtr,
+ 0) != TCL_OK) {
+ /*
+ * If we incremented a refcount, we must decrement it
+ * here as we will not be coming back properly due to
+ * the error.
+ */
+
+ if (protectedVarPtr) {
+ VarHashRefCount(protectedVarPtr)--;
+ }
+ return TCL_ERROR;
+ }
}
}
+ break;
}
- break;
- }
case ARRAY_SIZE: {
Tcl_HashSearch search;