How to propagate non-blocking inter-thread error return?

[Bob Binder]

I'd like to be able to "catch" (in a requestor thread) errors thrown
(in a server thread), when the send is non-blocking, i.e "-async".

The requestor side code looks like

thread::send -async $targetThreadID $targetCmd $replyDataName
vwait $replyDataName
set reply [set $replyDataName]

The server side code looks like

::itcl::body Server::command {} {

if { ! $ok } {
set e "action not allowed"
error $e
}

set x [something]
return $x
}

With this, the error percolates to the proc designated in thread::errorproc,
in the
server thread.

I want the functional equivalent of non-threaded error-catch processing, but
at
inter-thread scope.

I don't want to make the requestor thread block for a reply. I could revise
the
server side error command to "return" a reply recognizable as an exception,
but
that's undesirable for several reasons.

Thanks in advance for suggestions, etc.
Bob

[Kip Rugger]

The reply handling in thread::send is not all that great. I prefer to
ignore it completely. Then the basic operation is that of adding an
event to another thread's event queue; this is done with

thread::send -async id script

and we use no reply options. The reply, if needed, is sent back in
exactly the same way (from the worker thread).

The problem with this approach is that the thread extension knows what
thread sent you the request, but the stinky thing won't tell you who
it was. So I usually just code some simple wrappers.

package require Thread

set work_thread [thread::create -preserved]

# wrap thread::send
proc th_send { th_to script { reply {} } } {
set th_from [thread::id]
thread::send -async $th_to [list th_perform $th_from $script $reply]
}

# wrap request processing in worker thread
thread::send -async $work_thread {
proc th_perform { th_from script reply } {
set rc [catch $script rv]
if {$reply eq ""} return
set reply [string map [list %% % %F [thread::id] %E $rc %V $rv] $reply]
thread::send -async $th_from $reply
}
}

# sample code to process replies
proc print_answer { errorcode value } {
if $errorcode {
puts "error occurred - $value"
} else {
puts "answer is $value"
}
}

proc main {} {
global work_thread exit

th_send $work_thread { puts "hi there %T from [thread::id]" }
th_send $work_thread { expr 33*44 } { print_answer {%E} {%V} }
th_send $work_thread { expr i } { print_answer {%E} {%V} }
th_send $work_thread { error "some error" } { print_answer {%E} {%V} }

after 1000 set exit 1
}

main
vwait exit
thread::release -wait $work_thread

The output of the above is:

hi there tid0x400 from tid0x402
answer is 1452
error occurred - syntax error in expression "i": variable references require preceding $
error occurred - some error