diff options
Diffstat (limited to 'tests/oo.test')
| -rw-r--r-- | tests/oo.test | 137 |
1 files changed, 101 insertions, 36 deletions
diff --git a/tests/oo.test b/tests/oo.test index 8bc6363..8e2cb5f 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3296,56 +3296,121 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup { } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} -test oo-22.3 {OO and coroutines and info frame} -constraints knownBug -setup { - oo::class create A { - self { - variable result stop - method WithWorkers {nworkers args script} { - set workers {} - try { - for {set n 1} {$n <= $nworkers} {incr n} { - lappend workers [set worker [[self] new]] - $worker schedule {*}$args - } - return [uplevel 1 $script] - } finally { - foreach worker $workers {$worker destroy} - } - } - method run {nworkers} { - set result {} - set stopvar [my varname stop] - set stop false - my WithWorkers $nworkers [list my Work [my varname result]] { - after idle [namespace code {set stop true}] - vwait $stopvar - } - return $result +# Common code for oo-22.{3,4,5,6} +oo::class create WorkerBase +oo::class create WorkerSupport { + superclass oo::class WorkerBase + variable result stop + method WithWorkers {nworkers args script} { + set workers {} + try { + for {set n 1} {$n <= $nworkers} {incr n} { + lappend workers [set worker [[self] new]] + $worker schedule {*}$args } + return [uplevel 1 $script] + } finally { + foreach worker $workers {$worker destroy} + } + } + method run {nworkers} { + set result {} + set stopvar [my varname stop] + set stop false + my WithWorkers $nworkers [list my Work [my varname result]] { + after idle [namespace code {set stop true}] + vwait $stopvar } - method schedule {args} { - set coro [namespace current]::coro - if {![llength [info commands $coro]]} { - coroutine $coro {*}$args - } + return $result + } +} +oo::class create Worker { + superclass WorkerBase + method schedule {args} { + set coro [namespace current]::coro + if {![llength [info commands $coro]]} { + coroutine $coro {*}$args } + } + method Work args {error unimplemented} + method dump {} { + info frame [expr {[info frame] - 1}] + } +} +test oo-22.3 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly restored pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker method Work {var} { after 0 [info coroutine] yield - lappend $var [dump] + lappend $var [my dump] } } -} -body { - # Triggers a crash with incorrectly restored procPtr->cmdPtr - proc dump {} { - # Called from [A Work] after a coroutine suspend/resume - info frame [expr {[info frame] - 1}] + A run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} +} -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} +test oo-22.4 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works with the source class still around + oo::copy A B + B run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} + catch {B destroy} +} -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} +test oo-22.5 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works with the source class deleted + oo::copy A B + catch {A destroy} + B run 2 +} -cleanup { + catch {rename dump {}} + catch {B destroy} +} -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} +test oo-22.6 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } } + # Copies the methods, changing the declarer + # Test it works in the original source class with the copy around + oo::copy A B + B run 2 A run 2 } -cleanup { catch {rename dump {}} catch {A destroy} + catch {B destroy} } -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} +WorkerBase destroy # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { |