diff options
Diffstat (limited to 'tests/oo.test')
| -rw-r--r-- | tests/oo.test | 112 |
1 files changed, 111 insertions, 1 deletions
diff --git a/tests/oo.test b/tests/oo.test index e42c2ca..6fdc344 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.34 2009/12/09 18:40:47 dgp Exp $ +# RCS: @(#) $Id: oo.test,v 1.35 2010/01/28 10:25:05 dkf Exp $ package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -221,6 +221,18 @@ test oo-1.18 {OO: create object in NS with same name as global cmd} -setup { rename test-oo-1.18 {} A destroy } -result ::C +test oo-1.19 {basic test of OO functionality: teardown order} -body { + oo::object create o + namespace delete [info object namespace o] + o destroy + # Crashes on error +} -returnCodes error -result {invalid command name "o"} +test oo-1.20 {basic test of OO functionality: my teardown post rename} -body { + oo::object create obj + rename [info object namespace obj]::my ::AGlobalName + obj destroy + info commands ::AGlobalName +} -result {} test oo-2.1 {basic test of OO functionality: constructor} -setup { # This is a bit complex because it needs to run in a sub-interp as @@ -330,6 +342,104 @@ test oo-3.2 {basic test of OO functionality: destructor} -setup { } -cleanup { interp delete subinterp } -result {1 ::foo died 2 {}} +test oo-3.3 {basic test of OO functionality: destructor} -setup { + oo::class create foo + set result {} +} -cleanup { + foo destroy +} -body { + oo::define foo { + constructor {} {lappend ::result made} + destructor {lappend ::result died} + } + namespace delete [info object namespace [foo new]] + return $result +} -result {made died} +test oo-3.4 {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 + 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 { + 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 {} { + 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 + namespace delete [info object namespace obj] + lappend result [info commands ::objmy] +} -match glob -result {1 {can't read "state": no such variable} *::state {} {}} +test oo-3.6 {basic test of OO functionality: errors in destructor} -setup { + oo::class create cls +} -cleanup { + cls destroy +} -body { + oo::define cls destructor {error foo} + list [catch {[cls create obj] destroy} msg] $msg [info commands obj] +} -result {1 foo {}} +test oo-3.7 {basic test of OO functionality: errors in destructor} -setup { + oo::class create cls + set result {} + proc bgerror msg {lappend ::result $msg} +} -cleanup { + cls destroy + rename bgerror {} +} -body { + oo::define cls destructor {error foo} + list [rename [cls create obj] {}] \ + [update idletasks] $result [info commands obj] +} -result {{} {} foo {}} +test oo-3.8 {basic test of OO functionality: errors in destructor} -setup { + oo::class create cls + set result {} + proc bgerror msg {lappend ::result $msg} +} -cleanup { + cls destroy + rename bgerror {} +} -body { + oo::define cls destructor {error foo} + list [namespace delete [info object namespace [cls create obj]]] \ + [update idletasks] $result [info commands obj] +} -result {{} {} foo {}} test oo-4.1 {basic test of OO functionality: export} { set o [oo::object new] |