diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2024-05-20 13:38:38 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2024-05-20 13:38:38 (GMT) |
| commit | 8f8f97ec13fd3def9c005b821be3f21d432f7b4a (patch) | |
| tree | ad92436f627a2e05cdc9c871d8bec98617f38b52 | |
| parent | a7533c3012a8c642bf9fce8164895d8ea010e646 (diff) | |
| download | tcl-8f8f97ec13fd3def9c005b821be3f21d432f7b4a.zip tcl-8f8f97ec13fd3def9c005b821be3f21d432f7b4a.tar.gz tcl-8f8f97ec13fd3def9c005b821be3f21d432f7b4a.tar.bz2 | |
Test case to demonstrate [7842f33a5c]
| -rw-r--r-- | tests/oo.test | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/tests/oo.test b/tests/oo.test index 8e2cb5f..ecd39fd 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -4274,8 +4274,6 @@ test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} } -cleanup { base destroy } -result {{c d e} {c d e}} - - test oo-35.6 { Bug : teardown of an object that is a class that is an instance of itself } -setup { @@ -4297,7 +4295,37 @@ test oo-35.6 { } -cleanup { rename obj {} } -result done - +test oo-35.7 {Bug 7842f33a5c: destructor cascading} -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 + } + } + 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 {} cleanupTests |
