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%