Posted to tcl by hypnotoad at Fri Nov 30 21:14:14 GMT 2018view raw
- namespace eval ::test {}
- package require taotk
- oo::class create ::test::fake {
- constructor args {
- after 5000 [namespace code {my trigger}]
- }
- destructor {
- puts [list [self] is dead]
- }
- method trigger {} { set ::response ok }
- }
- proc ::test::dialog args {
- destroy .prompt
- set ::response {}
- set info [::tool::args_to_options {*}$args]
- set class ::taotk::dialog.[dict getnull $info type]
- if {[info command $class] eq {}} {
- set class ::taotk::dialog.ok
- }
- dict set info varname ::response
- puts [list CREATE OBJECT] ; update
- #set tempobj [$class create prompt .prompt {*}$info]
- set obj [::test::fake new]
- rename $obj .prompt
- set testobj .prompt
- if {[info coroutine] eq {}} {
- puts [list VWAIT] ; update
- ::vwait ::response
- } else {
- puts [list COROUTINE VWAIT] ; update
- ::coroutine::util::vwait ::response
- }
- puts [list DESTROY] ; update
- catch {$tempobj destroy}
- puts [list RETURN $::response] ; update
- return $::response
- }
- # TRANSCRIPT
- # wish% source ~/OneDrive/Documents/crashtest.tcl
- # wish% test::dialog
- # CREATE OBJECT
- # invalid command name ":test::fake"
- # wish% source ~/OneDrive/Documents/crashtest.tcl
- # can't create object "::test::fake": command already exists with that name
- # wish% test::fake destroy
- # wish% source ~/OneDrive/Documents/crashtest.tcl
- # wish% test::dialog
- # CREATE OBJECT
- # VWAIT
- # DESTROY
- # RETURN ok
- # ok
- # wish% test::dialog
- # CREATE OBJECT
- # can't rename to ".prompt": command already exists
- # wish% .prompt foo
- # invalid command name ".prompt"
- # wish% test::fake destroy
- # ::oo::Obj328 is dead
- # ::test::.prompt is dead
- # wish%