diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-02-02 09:13:45 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-02-02 09:13:45 (GMT) |
commit | dfbab38ae547e10b74c8c13190efc5015aa52b43 (patch) | |
tree | 0c0523334c2ccbee685dbb680e15f8246d65f1a8 /tests/oo.test | |
parent | a702b6e0b90ad920f1bd8821d028e281991f64ab (diff) | |
download | tcl-dfbab38ae547e10b74c8c13190efc5015aa52b43.zip tcl-dfbab38ae547e10b74c8c13190efc5015aa52b43.tar.gz tcl-dfbab38ae547e10b74c8c13190efc5015aa52b43.tar.bz2 |
[Bug 2944404] Be careful in case an object deletes itself in its destructor.
Diffstat (limited to 'tests/oo.test')
-rw-r--r-- | tests/oo.test | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/tests/oo.test b/tests/oo.test index 6fdc344..d831b3d 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.35 2010/01/28 10:25:05 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.36 2010/02/02 09:13:45 dkf Exp $ package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -440,6 +440,22 @@ test oo-3.8 {basic test of OO functionality: errors in destructor} -setup { list [namespace delete [info object namespace [cls create obj]]] \ [update idletasks] $result [info commands obj] } -result {{} {} foo {}} +test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup { + oo::class create cls + set result {} +} -body { + oo::define cls { + destructor { + lappend ::result in destructor + [self] destroy + } + } + # This used to crash + [cls new] destroy + return $result +} -cleanup { + cls destroy +} -result {in destructor} test oo-4.1 {basic test of OO functionality: export} { set o [oo::object new] |