Fix [Bug 2939073]: dangling ref when an unset trace triggered by [array unset]

hits the next element to be deleted.

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;