[Bug 3185009]: Keep references to resolved object variables so that an unset doesn't leave any dangling pointers for code to trip over.

3 files changed, 39 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 3976ccd..7274f4e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-03-04  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect)
+	(ProcedureMethodCompiledVarDelete): [Bug 3185009]: Keep references to
+	resolved object variables so that an unset doesn't leave any dangling
+	pointers for code to trip over.
+
 2011-03-01  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd)
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 44eb083..4f29337 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1055,6 +1055,14 @@ ProcedureMethodCompiledVarConnect(
     }
     if (cacheIt) {
 	infoPtr->cachedObjectVar = TclVarHashGetValue(hPtr);
+
+	/*
+	 * We must keep a reference to the variable so everything will
+	 * continue to work correctly even if it is unset; being unset does
+	 * not end the life of the variable at this level. [Bug 3185009]
+	 */
+
+	VarHashRefCount(infoPtr->cachedObjectVar)++;
     }
     return TclVarHashGetValue(hPtr);
 }
@@ -1065,6 +1073,14 @@ ProcedureMethodCompiledVarDelete(
 {
     OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
 
+    /*
+     * Release the reference to the variable if we were holding it.
+     */
+
+    if (infoPtr->cachedObjectVar) {
+	VarHashRefCount(infoPtr->cachedObjectVar)--;
+	TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
+    }
     Tcl_DecrRefCount(infoPtr->variableObj);
     ckfree((char *) infoPtr);
 }
diff --git a/tests/oo.test b/tests/oo.test
index 395e345..60d0077 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2578,6 +2578,22 @@ test oo-27.12 {variables declaration: leak per instance} -setup {
 } -cleanup {
     foo destroy
 } -result 0
+# This test will actually (normally) crash if it fails!
+test oo-27.13 {variables declaration: Bug 3185009: require refcount management} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo {
+	variable x
+	method set v {set x $v}
+	method unset {} {unset x}
+	method exists {} {info exists x}
+	method get {} {return $x}
+    }
+    list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \
+	[foo exists] [catch {foo get} msg] $msg
+} -cleanup {
+    foo destroy
+} -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}}
 
 # A feature that's not supported because the mechanism may change without
 # warning, but is supposed to work...