Posted to tcl by hypnotoad at Fri Nov 30 21:31:01 GMT 2018view raw

  1. namespace eval ::test {}
  2. package require taotk
  3.  
  4. oo::class create ::test::fake {
  5. constructor args {
  6. after 5000 [namespace code {my trigger}]
  7. }
  8. destructor {
  9. puts [list [self] is dead]
  10. }
  11. method trigger {} { set ::response ok }
  12. }
  13.  
  14. proc ::test::dialog args {
  15. destroy .prompt
  16. set ::response {}
  17. set info [::tool::args_to_options {*}$args]
  18. set class ::taotk::dialog.[dict getnull $info type]
  19. if {[info command $class] eq {}} {
  20. set class ::taotk::dialog.ok
  21. }
  22. dict set info varname ::response
  23. puts [list CREATE OBJECT] ; update
  24. #set tempobj [$class create prompt .prompt {*}$info]
  25. set obj [::test::fake new]
  26. puts [list $obj -> .prompt]
  27. rename $obj .prompt
  28. set testobj .prompt
  29.  
  30. if {[info coroutine] eq {}} {
  31. puts [list VWAIT] ; update
  32. ::vwait ::response
  33. } else {
  34. puts [list COROUTINE VWAIT] ; update
  35. ::coroutine::util::vwait ::response
  36. }
  37. puts [list DESTROY] ; update
  38. catch {$tempobj destroy}
  39. puts [list RETURN $::response] ; update
  40. return $::response
  41. }
  42.  
  43. # Transcript with Tcl 8.6.8
  44. #
  45. # basra:tcl seandeelywoods$ fossil status
  46. # repository: /Users/seandeelywoods/odie/download/tcl.fos
  47. # local-root: /Users/seandeelywoods/build/irm-rage/tcl/
  48. # config-db: /Users/seandeelywoods/.fossil
  49. # checkout: 1e46dacaaba10131046c0871878d93c462b877e8 2017-12-19 20:53:27 UTC
  50. # parent: fe783af8319aaef2c123a660cfcdb604b811cc49 2017-12-19 14:46:31 UTC
  51. # merged-from: 1a04c85a4f9d8e4669b22fe31bd943c75f9780aa 2017-12-19 20:48:52 UTC
  52. # child: 2a6e85361613b22ee679e4fb8de5d6c70e64a23d 2018-03-27 07:48:33 UTC
  53. # merged-into: 357365b9054897d86397354d77a1aef974da35ae 2017-12-23 18:33:36 UTC
  54. # tags: release, core-8-6-8, core-8-6-8-rc
  55. # comment: merge 8.6; update changes (user: dgp)
  56. #
  57. # wish% source ~/OneDrive/Documents/crashtest.tcl
  58. # wish% test::dialog
  59. # CREATE OBJECT
  60. # ::oo::Obj326 -> .prompt
  61. # VWAIT
  62. # DESTROY
  63. # RETURN ok
  64. # ok
  65. # wish% test::dialog
  66. # CREATE OBJECT
  67. # ::oo::Obj327 -> .prompt
  68. # can't rename to ".prompt": command already exists
  69. # wish% .prompt trigger
  70. # invalid command name ".prompt"
  71. # wish% test::dialog
  72. # CREATE OBJECT
  73. # ::oo::Obj328 -> .prompt
  74. # can't rename to ".prompt": command already exists
  75. # wish% test::fake destroy
  76. # {} is dead
  77. # ::oo::Obj327 is dead
  78. # ::oo::Obj328 is dead
  79. # wish%
  80.  
  81. # Transcript with Tcl 8.6.9
  82. #
  83. # basra:tcl seandeelywoods$ fossil status
  84. # repository: /Users/seandeelywoods/odie/download/tcl.fos
  85. # local-root: /Users/seandeelywoods/build/irm-rage/tcl/
  86. # config-db: /Users/seandeelywoods/.fossil
  87. # checkout: 770e6649a47ac43aabb2530a01b6129700889528 2018-11-16 18:45:59 UTC
  88. # parent: 27603fe3a87e844a1aae2299e763083914b813e6 2018-11-09 19:14:07 UTC
  89. # merged-into: 7aa0a364d51ee29af35623e6f131d636ede6804e 2018-11-16 20:26:14 UTC
  90. # tags: release, core-8-6-9, core-8-6-9-rc
  91. # comment: [00d04c4f12] Repair broken edge cases in [binary encode base64]. (user: dgp)
  92. #
  93. # wish% source ~/OneDrive/Documents/crashtest.tcl
  94. # wish% test::dialog
  95. # CREATE OBJECT
  96. # ::oo::Obj333 -> .prompt
  97. # VWAIT
  98. # DESTROY
  99. # RETURN ok
  100. # ok
  101. # wish% test::dialog
  102. # CREATE OBJECT
  103. # ::oo::Obj334 -> .prompt
  104. # can't rename to ".prompt": command already exists
  105. # wish% .prompt trigger
  106. # invalid command name ".prompt"
  107. # wish% info commands .prompt
  108. # wish% test::dialog
  109. # CREATE OBJECT
  110. # ::oo::Obj335 -> .prompt
  111. # can't rename to ".prompt": command already exists
  112. # wish% rename .prompt {}
  113. # can't delete ".prompt": command doesn't exist
  114. # wish% test::fake destroy
  115. # ::oo::Obj335 is dead
  116. # ::oo::Obj334 is dead
  117. # ::test::.prompt is dead
  118. # wish%