Posted to tcl by hypnotoad at Fri Nov 30 21:14:14 GMT 2018view pretty
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%