Posted to tcl by Julian Noble at Thu Mar 06 07:09:19 GMT 2025view raw

  1. set arg1 [lindex $::argv 0]
  2.  
  3. interp create code1
  4. interp create code2
  5.  
  6.  
  7. puts stderr "loading Thread package in all 3 interps"
  8. package require Thread
  9. code1 eval {package require Thread}
  10. code2 eval {package require Thread}
  11.  
  12. puts stderr "establishing ::testfunc proc in all 3 interps"
  13. code1 eval {proc ::testfunc {args} {puts stderr "evaluated in code1 interp: $args"}}
  14. code2 eval {proc ::testfunc {args} {puts stderr "evaluated in code2 interp: $args"}}
  15. proc ::testfunc {args} {puts stderr "evaluated in parent interp: $args"}
  16.  
  17.  
  18. puts stderr "Calling a thread function in nominated interp '$arg1' first"
  19. #1st use of thread function makes that interp the one to receive all subsequent messages
  20. switch -- $arg1 {
  21. parent {
  22. thread::id
  23. }
  24. code1 {
  25. code1 eval {thread::id}
  26. }
  27. code2 {
  28. code2 eval {thread::id}
  29. }
  30. default {
  31. puts stderr "Usage thread_interp.tcl parent|code1|code1"
  32. exit 1
  33. }
  34. }
  35.  
  36.  
  37. puts stderr "sending scripts"
  38. thread::send -async [thread::id] {
  39. ::testfunc script sent from parent interp
  40. }
  41. code1 eval {
  42. thread::send -async [thread::id] {
  43. ::testfunc script sent from code1 interp
  44. }
  45. }
  46. code2 eval {
  47. thread::send -async [thread::id] {
  48. ::testfunc script sent from code2 interp
  49. }
  50. }
  51. #test
  52. after 0 {::testfunc after script in parent interp}
  53. code1 eval {after 0 {::testfunc after script in code1 interp}}
  54. code2 eval {after 0 {::testfunc after script in code2 interp}}
  55.  
  56.  
  57. code1 eval {
  58. set workertid [thread::create]
  59. thread::send $workertid {package require Thread}
  60. thread::send $workertid [list thread::send -async [thread::id] {
  61. ::testfunc script sent from code1 interp via worker
  62. }]
  63. }
  64.  
  65. after idle {set ::done 1}
  66. vwait ::done
  67.  
  68.  
  69.  
  70.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week