Arjen Markus (31 march 2014) Last week I was trying to run a program with some 150 different input data sets. No problem in automating that, but the program would fail with certain data sets, causing a window to pop up asking me to close it or to debug it (this is on Windows 7). It would wait until I answered. Of course this prevented me from having lunch and finding all input sets processed. Sigh. SO I started thinking whether it would be possible to run the program with a more convenient timeout - it would get only say 1 minute to finish its job, after that it would get terminated and the Tcl program would get on with the next. Well, it works more or less satisfactorily via the code below.
The unsatisfactory bit: the message window does not go away and you can not kill the program properly because the original process ID seems to be lost. I do not intend to find out what is really happening here I just want to prevent endless waiting. Perhaps someone can explain what is going on. Until that time, here is my code.
# controlled_command.tcl --
# Run an external command, but allow it to run for a limited time only,
# to prevent a hanging process from halting everything
#
# Note:
# This works fine for programs that do not finish in time, but for
# programs that produce a message window stating the program has stopped
# and giving you the possibility to close the program or to debug it,
# which may happen on Windows, it does not quite work. This is entirely
# due to the way this sort of things work under Windows: the tskill
# command can not get rid of the message window and whatever process
# is responsible for it either.
#
# Still it prevents the rest of the program from hanging.
#
proc run {cmd timeout} {
global finished
puts "Run: $cmd"
set infile [open "|$cmd"]
fileevent $infile readable [list getinput $infile]
after $timeout [string map [list INFILE $infile] {
exec tskill [pid INFILE]
set finished 1
puts "Killed the process"
}]
vwait finished
}
proc getinput {infile} {
global finished
if { [gets $infile line] >= 0 } {
puts $line
} else {
puts "Closing input ..."
catch {
exec tskill [pid $infile]
} msg
puts $msg
close $infile
set finished 1
}
}
run "tclsh testing.tcl" 2000
run "somewhat_buggy_program.exe" 2000
puts DoneThe C code for the buggy (or at least not-always-well-behaved program) is lengthy, it is also not mine, so I won't put it on the Wiki. The little test program "testing.tcl" though is simple enough to put here:
# testing.tcl --
# Produce some output, then finish
#
for {set i 0} {$i < 100} {incr i} {
puts $i
after 100
}