How to detect an error in a Tcl thread fileevent or after script -
in main thread trying detect , respond error occurs in worker thread's fileevent script. wrote test script try detect thread errors in 4 cases:
- synchronous thread::send, immediate error in thread
- synchronous thread::send, error in thread after script
- asynchronous thread::send, immediate error in thread
- asynchronous thread::send, error in thread after script
i used after command in test thread (hopefully) mimic fileevent script. expected, case 1 thread error caught via catch of thread::send command , case 3 thread error caught thread::errorproc procedure , custom bgerror procedure. cases 2 , 4 thread errors reflected in main thread can't seem catch them via custom procedures.
following test script:
#!/usr/bin/env tclsh package require thread; # custom error handling procedure errors during asynchronous thread::send proc error_proc {id error} { puts "\n---------- error_proc: $id $error **********\n"; } thread::errorproc error_proc; # custom error , bgerror procedures try see thread error rename error original_error; proc error {err} { puts "---------- error: $err\n"; } proc bgerror {err} { puts "---------- bgerror: $err\n"; } # non-blocking wait procedure keep output in order proc waitms {ms} { set ::done 0; after $ms {set ::done 1}; vwait ::done; } # create worker thread set tid [thread::create { proc test_error_immediately {s} { error "test_error_immediately ($s)"; } proc test_error_after {ms s} { after $ms [list error "test_error_after ($s)"]; } thread::wait; puts "---------- exiting thread"; }] # test case 1 - synchronous thread::send, immediate error if {[catch {thread::send $tid [list test_error_immediately "case 1"]} result]} { set state "error"; } else { set state "ok"; } puts "---------- synchronous test_error_immediately $state ($result)\n" # test case 2 - synchronous thread::send, error in thread after script if {[catch {thread::send $tid [list test_error_after 1000 "case 2"]} result]} { set state "error"; } else { set state "ok"; } puts "---------- synchronous test_error_after $state ($result)\n"; # wait output in order waitms 1500; # test case 3 - asynchronous thread::send, immediate error if {[catch {thread::send -async $tid [list test_error_immediately "case 3"] result} catch_result]} { set state "error"; set result $catch_result; } else { set state "ok"; vwait result; } puts "---------- asynchronous test_error_immediately $state ($result)\n"; # wait output in order waitms 100; # test case 4 - asynchronous thread::send, error in thread after script if {[catch {thread::send -async $tid [list test_error_after 1000 "case 4"] result} catch_result]} { set state "error"; set result $catch_result; } else { set state "ok"; vwait result; } puts "---------- asynchronous test_error_after $state ($result)\n"; # clean if {[thread::exists $tid]} { after 2000 { thread::release $::tid; puts "\n---------- $::tid released\n"; } } puts "---------- waiting forever ...\n"; vwait forever; following output on computer:
---------- synchronous test_error_immediately error (test_error_immediately (case 1)) ---------- synchronous test_error_after ok (after#0) test_error_after (case 2) while executing "error {test_error_after (case 2)}" ("after" script) ---------- error_proc: tid0x7f5673e9d700 test_error_immediately (case 3) while executing "error "test_error_immediately ($s)"" (procedure "test_error_immediately" line 2) invoked within "test_error_immediately {case 3}" ********** ---------- asynchronous test_error_immediately ok (test_error_immediately (case 3)) ---------- bgerror: test_error_immediately (case 3) ---------- asynchronous test_error_after ok (after#1) ---------- waiting forever ... test_error_after (case 4) while executing "error {test_error_after (case 4)}" ("after" script) ---------- tid0x7f5673e9d700 released ---------- exiting thread i using tcl 8.5 , ubuntu 10.04 lts.
do have other suggestions on how detect error occurs within thread's fileevent or after script?
regards,
smercer
Comments
Post a Comment