punkshell/scriptlib/thread_interp.tcl

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