summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:11:30 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-02-02 00:11:30 (GMT)
commita2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3 (patch)
tree6b1f1a1d72ac03c844a4d8bf2d0ba47401b0e28b /generic/tclVar.c
parenta4eb99f2549d55277cc2803158db4bcbdc074a95 (diff)
downloadtcl-a2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3.zip
tcl-a2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3.tar.gz
tcl-a2138bd6664eaf8ec5a4dcf1b66a78ee9c9fa8f3.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/tclVar.c')
-rw-r--r--generic/tclVar.c79
1 files changed, 59 insertions, 20 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index dccbfbb..5e7ec1e 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.186 2010/01/31 22:33:06 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.187 2010/02/02 00:11:31 dkf Exp $
*/
#include "tclInt.h"
@@ -3211,11 +3211,7 @@ Tcl_ArrayObjCmd(
return TCL_ERROR;
}
return TclArraySet(interp, objv[2], objv[3]);
- case ARRAY_UNSET: {
- Tcl_HashSearch search;
- Var *varPtr2;
- const char *pattern = NULL;
-
+ case ARRAY_UNSET:
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
return TCL_ERROR;
@@ -3228,11 +3224,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)) {
@@ -3240,23 +3241,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;