diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 16 | ||||
| -rw-r--r-- | tests/oo.test | 16 |
3 files changed, 39 insertions, 0 deletions
@@ -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... |