From 090a10bc43c3eb76b987c94d3d65674ba4b40ec9 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 20 May 2024 15:09:01 +0000 Subject: Fix for [7842f33a5c]: Stereotype call chains were ending up bogus in some situations --- generic/tclOOCall.c | 58 +++++++++++++++++++++++++++++++++++----- tests/oo.test | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 128 insertions(+), 7 deletions(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index aefd921..bfff4e9 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -891,15 +891,28 @@ InitCallChain( Object *oPtr, int flags) { + /* + * Note that it's possible to end up with a NULL oPtr->selfCls here if + * there is a call into stereotypical object after it has finished running + * its destructor phase. Such things can't be cached for a long time so the + * epoch can be bogus. [Bug 7842f33a5c] + */ + callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); if (oPtr->flags & USE_CLASS_CACHE) { - oPtr = oPtr->selfCls->thisPtr; + oPtr = (oPtr->selfCls ? oPtr->selfCls->thisPtr : NULL); callPtr->flags |= USE_CLASS_CACHE; } - callPtr->epoch = oPtr->fPtr->epoch; - callPtr->objectCreationEpoch = oPtr->creationEpoch; - callPtr->objectEpoch = oPtr->epoch; + if (oPtr) { + callPtr->epoch = oPtr->fPtr->epoch; + callPtr->objectCreationEpoch = oPtr->creationEpoch; + callPtr->objectEpoch = oPtr->epoch; + } else { + callPtr->epoch = 0; + callPtr->objectCreationEpoch = 0; + callPtr->objectEpoch = 0; + } callPtr->refCount = 1; callPtr->numChain = 0; callPtr->chain = callPtr->staticChain; @@ -930,6 +943,13 @@ IsStillValid( int mask) { if ((oPtr->flags & USE_CLASS_CACHE)) { + /* + * If the object is in a weird state (due to stereotype tricks) then + * just declare the cache invalid. [Bug 7842f33a5c] + */ + if (!oPtr->selfCls) { + return 0; + } oPtr = oPtr->selfCls->thisPtr; flags |= USE_CLASS_CACHE; } @@ -1020,8 +1040,16 @@ TclOOGetCallContext( FreeMethodNameRep(cacheInThisObj); } - if (oPtr->flags & USE_CLASS_CACHE) { - if (oPtr->selfCls->classChainCache != NULL) { + /* + * Note that it's possible to end up with a NULL oPtr->selfCls here if + * there is a call into stereotypical object after it has finished + * running its destructor phase. It's quite a tangle, but at that + * point, we simply can't get stereotypes from the cache. + * [Bug 7842f33a5c] + */ + + if (oPtr->flags & USE_CLASS_CACHE && oPtr->selfCls) { + if (oPtr->selfCls->classChainCache) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, (char *) methodNameObj); } else { @@ -1226,6 +1254,17 @@ TclOOGetStereotypeCallChain( Object obj; /* + * Note that it's possible to end up with a NULL clsPtr here if there is + * a call into stereotypical object after it has finished running its + * destructor phase. It's quite a tangle, but at that point, we simply + * can't get stereotypes. [Bug 7842f33a5c] + */ + + if (clsPtr == NULL) { + return NULL; + } + + /* * Synthesize a temporary stereotypical object so that we can use existing * machinery to produce the stereotypical call chain. */ @@ -1448,9 +1487,16 @@ AddSimpleClassChainToCallContext( * * Note that mixins must be processed before the main class hierarchy. * [Bug 1998221] + * + * Note also that it's possible to end up with a null classPtr here if + * there is a call into stereotypical object after it has finished running + * its destructor phase. [Bug 7842f33a5c] */ tailRecurse: + if (classPtr == NULL) { + return; + } FOREACH(superPtr, classPtr->mixins) { AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); diff --git a/tests/oo.test b/tests/oo.test index ecd39fd..366f4d3 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -4295,7 +4295,7 @@ test oo-35.6 { } -cleanup { rename obj {} } -result done -test oo-35.7 {Bug 7842f33a5c: destructor cascading} -setup { +test oo-35.7.1 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { oo::class create base oo::class create RpcClient { superclass base @@ -4326,6 +4326,81 @@ test oo-35.7 {Bug 7842f33a5c: destructor cascading} -setup { } -cleanup { base destroy } -result {} +test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + MkObjectRpc create cfg [self] 111 + } + destructor { + lappend ::result "Destroyed" + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result {Destroyed} +test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + variable interiorObjects + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + set obj [MkObjectRpc create cfg [self] 111] + lappend interiorObjects $obj + return $obj + } + destructor { + lappend ::result "Destroyed" + # Explicit destroy of interior objects + foreach obj $interiorObjects { + $obj destroy + } + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result "Destroyed\nRpcClient -> otto-111" cleanupTests -- cgit v0.12