Posted to tcl by hypnotoad at Fri Nov 30 21:31:01 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] puts [list $obj -> .prompt] 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 with Tcl 8.6.8 # # basra:tcl seandeelywoods$ fossil status # repository: /Users/seandeelywoods/odie/download/tcl.fos # local-root: /Users/seandeelywoods/build/irm-rage/tcl/ # config-db: /Users/seandeelywoods/.fossil # checkout: 1e46dacaaba10131046c0871878d93c462b877e8 2017-12-19 20:53:27 UTC # parent: fe783af8319aaef2c123a660cfcdb604b811cc49 2017-12-19 14:46:31 UTC # merged-from: 1a04c85a4f9d8e4669b22fe31bd943c75f9780aa 2017-12-19 20:48:52 UTC # child: 2a6e85361613b22ee679e4fb8de5d6c70e64a23d 2018-03-27 07:48:33 UTC # merged-into: 357365b9054897d86397354d77a1aef974da35ae 2017-12-23 18:33:36 UTC # tags: release, core-8-6-8, core-8-6-8-rc # comment: merge 8.6; update changes (user: dgp) # # wish% source ~/OneDrive/Documents/crashtest.tcl # wish% test::dialog # CREATE OBJECT # ::oo::Obj326 -> .prompt # VWAIT # DESTROY # RETURN ok # ok # wish% test::dialog # CREATE OBJECT # ::oo::Obj327 -> .prompt # can't rename to ".prompt": command already exists # wish% .prompt trigger # invalid command name ".prompt" # wish% test::dialog # CREATE OBJECT # ::oo::Obj328 -> .prompt # can't rename to ".prompt": command already exists # wish% test::fake destroy # {} is dead # ::oo::Obj327 is dead # ::oo::Obj328 is dead # wish% # Transcript with Tcl 8.6.9 # # basra:tcl seandeelywoods$ fossil status # repository: /Users/seandeelywoods/odie/download/tcl.fos # local-root: /Users/seandeelywoods/build/irm-rage/tcl/ # config-db: /Users/seandeelywoods/.fossil # checkout: 770e6649a47ac43aabb2530a01b6129700889528 2018-11-16 18:45:59 UTC # parent: 27603fe3a87e844a1aae2299e763083914b813e6 2018-11-09 19:14:07 UTC # merged-into: 7aa0a364d51ee29af35623e6f131d636ede6804e 2018-11-16 20:26:14 UTC # tags: release, core-8-6-9, core-8-6-9-rc # comment: [00d04c4f12] Repair broken edge cases in [binary encode base64]. (user: dgp) # # wish% source ~/OneDrive/Documents/crashtest.tcl # wish% test::dialog # CREATE OBJECT # ::oo::Obj333 -> .prompt # VWAIT # DESTROY # RETURN ok # ok # wish% test::dialog # CREATE OBJECT # ::oo::Obj334 -> .prompt # can't rename to ".prompt": command already exists # wish% .prompt trigger # invalid command name ".prompt" # wish% info commands .prompt # wish% test::dialog # CREATE OBJECT # ::oo::Obj335 -> .prompt # can't rename to ".prompt": command already exists # wish% rename .prompt {} # can't delete ".prompt": command doesn't exist # wish% test::fake destroy # ::oo::Obj335 is dead # ::oo::Obj334 is dead # ::test::.prompt is dead # wish%