diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-02-15 11:53:43 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-02-15 11:53:43 (GMT) |
commit | a0d1a202239c64ab548f9d515bba530fb475d743 (patch) | |
tree | 58ef89d3285974776896099a22e8bea82da7cef4 /tests | |
parent | 2a083e870cd9bd162468f535c9a9b724516353ea (diff) | |
download | tcl-a0d1a202239c64ab548f9d515bba530fb475d743.zip tcl-a0d1a202239c64ab548f9d515bba530fb475d743.tar.gz tcl-a0d1a202239c64ab548f9d515bba530fb475d743.tar.bz2 |
Fix [Bug 2950259] so that deleting an object by killing its namespace will
reliably call the object's destructor.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/oo.test | 60 |
1 files changed, 52 insertions, 8 deletions
diff --git a/tests/oo.test b/tests/oo.test index d831b3d..fbb8971 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: oo.test,v 1.36 2010/02/02 09:13:45 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.37 2010/02/15 11:53:45 dkf Exp $ package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -379,17 +379,36 @@ test oo-3.4 {basic test of OO functionality: my exists in destructor} -setup { obj destroy lappend result [info commands ::objmy] } -match glob -result {0 ok *::state localcmdexists {}} -# Compare with previous test; the differences are because here the destructor -# is run with the namespace partially squelched. -test oo-3.5 {basic test of OO functionality: my exists in destructor} -setup { +test oo-3.4a {basic test of OO functionality: my exists in destructor} -setup { + oo::class create cls + set result {} +} -cleanup { + cls destroy +} -body { + oo::define cls { + variable state + constructor {} { + proc localcmdexists {} {} + set state ok + } + forward Report lappend ::result + destructor { + objmy Report [catch {set state} msg] $msg + objmy Report [namespace which -var state] + objmy Report [info commands localcmdexists] + } + } + cls create obj + rename [info object namespace obj]::my ::objmy + rename obj {} + lappend result [info commands ::objmy] +} -match glob -result {0 ok *::state localcmdexists {}} +test oo-3.5 {basic test of OO functionality: destructor: evil case for Itcl} -setup { oo::class create cls set result {} } -cleanup { cls destroy } -body { - # Order of destruction of commands relative to namespace is complex, but - # we want to make sure that the order from the perspective of TclOO is - # solid. oo::define cls { variable state constructor {} { @@ -407,7 +426,32 @@ test oo-3.5 {basic test of OO functionality: my exists in destructor} -setup { rename [info object namespace obj]::my ::objmy namespace delete [info object namespace obj] lappend result [info commands ::objmy] -} -match glob -result {1 {can't read "state": no such variable} *::state {} {}} +} -match glob -result {0 ok *::state localcmdexists {}} +test oo-3.5a {basic test of OO functionality: destructor: evil case for Itcl} -setup { + oo::class create cls + set result {} +} -cleanup { + cls destroy +} -body { + oo::define cls { + variable state result + constructor {} { + proc localcmdexists {} {} + set state ok + my eval {upvar 0 ::result result} + } + method nuke {} { + namespace delete [namespace current] + return $result + } + destructor { + lappend result [self] $state [info commands localcmdexists] + } + } + cls create obj + namespace delete [info object namespace obj] + [cls create obj2] nuke +} -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists} test oo-3.6 {basic test of OO functionality: errors in destructor} -setup { oo::class create cls } -cleanup { |