set arg1 [lindex $::argv 0] interp create code1 interp create code2 puts stdout "Testing target interpreter of thread::send." puts stdout "For tcl 8.6 (?) The target interp can vary depending on which interp first called a thread function such as thread::id." puts stdout "For tcl 9 - there is a difference between -async and non-async target interp *when sending to own thread*" puts stdout "loading Thread package in all interps" puts stdout "auto_path in parent interp: $::auto_path" code1 eval [list set ::auto_path $::auto_path] code2 eval [list set ::auto_path $::auto_path] set tversion_code1 [code1 eval {package require Thread}] set tversion_code2 [code2 eval {package require Thread}] set tversion_parent [package require Thread] #puts stdout "Thread version in parent interp: $tversion_parent" puts stdout "establishing ::testfunc proc in all interps" code1 eval {proc ::testfunc {args} {puts stdout "evaluated in \x1b\[31mcode1\x1b\[m interp: $args"}} code2 eval {proc ::testfunc {args} {puts stderr "evaluated in \x1b\[33mcode2\x1b\[m interp: $args"}} proc ::testfunc {args} {puts stdout "evaluated in \x1b\[32mparent\x1b\[m interp: $args"} puts stderr "Calling a thread function in nominated interp '$arg1' first" #1st use of thread function makes that interp the one to receive all subsequent messages switch -- $arg1 { parent { thread::id } code1 { code1 eval {thread::id} } code2 { code2 eval {thread::id} } default { #puts stderr "Usage thread_interp.tcl parent|code1|code2" puts stderr "Usage thread_interp.tcl parent|code1" exit 1 } } puts stdout "sending scripts" puts stdout "send to own thread::id from child interp" puts stdout "----------------------------------------" #sending to own thread from child interp. code1 eval { thread::send [thread::id] { ::testfunc script sent from code1 interp } } code1 eval { package require Thread thread::send -async [thread::id] { ::testfunc script sent from code1 interp with -async } } code1 eval { thread::send [thread::id] {} } after 1000 puts stdout "----------------------------------------" flush stdout code2 eval { thread::send [thread::id] { ::testfunc script sent from code2 interp } } code2 eval { package require Thread thread::send -async [thread::id] { ::testfunc script sent from code2 interp with -async } } code1 eval { set workertid [thread::create] thread::send $workertid {package require Thread} thread::send -async $workertid [list thread::send [thread::id] { ::testfunc script sent from code1 interp via worker }] } code1 eval { set workertid [thread::create] thread::send $workertid {package require Thread} thread::send $workertid [list thread::send -async [thread::id] { ::testfunc script sent from code1 interp via worker -async }] } set workertid [thread::create -preserved] thread::send -async $workertid [list set ::auto_path $::auto_path] #thread::send -async $workertid {package require Thread} thread::send -async $workertid {interp create code1} thread::send $workertid [list code1 eval [list set ::auto_path $::auto_path]] thread::send $workertid [list code1 eval {package require Thread}] #thread::send -async $workertid {puts --------------------; flush stdout} thread::send -async $workertid [list code1 eval {puts stdout "workerthread: [thread::id]"}] thread::send -async $workertid [list code1 eval [list thread::send [thread::id] { ::testfunc script sent from worker }]] after idle {set ::done 1} vwait ::done #exit 1 thread::send -async $workertid [list thread::send -async [thread::id] { ::testfunc script sent from parent interp via worker -async }] thread::send [thread::id] { ::testfunc script sent from parent interp } thread::send -async [thread::id] { ::testfunc script sent from parent interp with -async } puts stdout "done sending scripts" flush stdout after idle {set ::done 1} #after 1000 {set ::done 1} vwait ::done