if {![file exists ${executable}]} {
perror "The executable, \"$executable\" is missing" 0
return "No source file found"
+ } elseif {![file executable ${executable}]} {
+ perror "The executable, \"$executable\" is not usable" 0
+ return "Bad executable found"
}
verbose "params: $params" 2
set args [concat $args ${params}]
verbose "args: $args" 2
- eval spawn -noecho $args
-
- expect_after full_buffer { error "got full_buffer" }
+ # We checked that the executable exists above, and can be executed, but
+ # that does not cover other reasons that the launch could fail (e.g.
+ # missing or malformed params); catch such cases here and report them.
+ set err [catch "spawn -noecho $args" pid]
+ set sub_proc_id $spawn_id
+ if { $pid <= 0 || $err != 0 || $sub_proc_id < 0 } {
+ warning "failed to spawn : $args : err = $err"
+ }
+
+ # Increase the buffer size, if needed to avoid spurious buffer-full
+ # events; GCC uses 10000; chose a power of two here.
+ set current_max_match [match_max -i $sub_proc_id]
+ if { $current_max_match < 8192 } {
+ match_max -i $sub_proc_id 8192
+ set used [match_max -i $sub_proc_id]
+ }
+
+ # If we get a buffer-full error, that seems to be unrecoverable so try to
+ # exit in a reasonable manner to avoid wedged processes.
+ expect_after full_buffer {
+ verbose -log "fixed_host_execute: $args FULL BUFFER"
+ # FIXME: this all assumes that closing the connection will cause the
+ # sub-process to terminate (but that is not going to be the case if,
+ # for example, there is something started with -nohup somewhere).
+ # We should explicitly kill it here.
+ # Set the process to be a nowait exit.
+ wait -nowait -i $sub_proc_id
+ catch close
+ perror "${executable} got full_buffer"
+ return "${executable} got full_buffer"
+ }
set prefix "\[^\r\n\]*"
+ # Work around a Darwin tcl or termios bug that sometimes inserts extra
+ # CR characters into the cooked tty stream
+ set endline "\r\n"
+ if { [istarget *-*-darwin*] } {
+ set endline "\r(\r)*\n"
+ }
+
+ # Note that the logic here assumes that we cannot (validly) get single
+ # carriage return or line feed characters in the stream. If those occur,
+ # it will stop any further matching. We arange for the matching to be
+ # at the start of the buffer - so that if there is any spurious output
+ # to be discarded, it must be done explicitly - not by matching part-way
+ # through the buffer.
expect {
- -re "^$prefix\[0-9\]\[0-9\]:..:..:${text}*\r\n" {
+ -re "^$prefix\[0-9\]\[0-9\]:..:..:${text}*$endline" {
regsub "\[\n\r\t\]*NOTE: $text\r\n" $expect_out(0,string) "" output
verbose "$output" 3
set timetol 0
exp_continue
}
- -re "^$prefix\tNOTE:\[^\r\n\]+\r\n" {
- regsub "\[\n\r\t\]*NOTE: $text\r\n" $expect_out(0,string) "" output
- set output [string range $output 6 end-2]
- verbose "$output" 2
+ -re "^\tNOTE: (\[^\r\n\]+)$endline" {
+ # discard notes.
+ verbose "Ignored note: $expect_out(1,string)" 2
set timetol 0
exp_continue
}
- -re "^$prefix\tPASSED:\[^\r\n\]+\r\n" {
- regsub "\[\n\r\t\]*PASSED: $text\r\n" $expect_out(0,string) "" output
- set output [string range $output 8 end-2]
- pass "$output"
+ -re "^\tPASSED: (\[^\r\n\]+)$endline" {
+ pass "$expect_out(1,string)"
set timetol 0
exp_continue
}
- -re "^$prefix\tFAILED:\[^\r\n\]+\r\n" {
- regsub "\[\n\r\t\]*FAILED: $text\r\n" $expect_out(0,string) "" output
- set output [string range $output 8 end-2]
- fail "$output"
+ -re "^\tFAILED: (\[^\r\n\]+)$endline" {
+ fail "$expect_out(1,string)"
set timetol 0
exp_continue
}
- -re "^$prefix\tUNTESTED:\[^\r\n\]+\r\n" {
- regsub "\[\n\r\t\]*TESTED: $text\r\n" $expect_out(0,string) "" output
- set output [string range $output 8 end-2]
- untested "$output"
+ -re "^\tUNTESTED: (\[^\r\n\]+)$endline" {
+ untested "$expect_out(1,string)"
set timetol 0
exp_continue
}
- -re "^$prefix\tUNRESOLVED:\[^\r\n\]+\r\n" {
- regsub "\[\n\r\t\]*UNRESOLVED: $text\r\n" $expect_out(0,string) "" output
- set output [string range $output 8 end-2]
- unresolved "$output"
+ -re "^\tUNRESOLVED: (\[^\r\n\]+)$endline" {
+ unresolved "$expect_out(1,string)"
set timetol 0
exp_continue
}
- -re "^Totals" {
- verbose "All done" 2
+ -re "^$prefix$endline" {
+ # This matches and discards any other lines (including blank ones).
+ if { [string length $expect_out(buffer)] <= 2 } {
+ set output "blank line"
+ } else {
+ set output [string range $expect_out(buffer) 0 end-2]
+ }
+ verbose -log "DISCARDED $expect_out(spawn_id) : $output"
+ exp_continue
}
eof {
- # unresolved "${executable} died prematurely"
- # catch close
- # return "${executable} died prematurely"
+ # This seems to be the only way that we can reliably know that the
+ # output is finished since there are cases where further output
+ # follows the dejagnu test harness totals.
+ verbose "saw eof" 2
}
timeout {
- warning "Timed out executing test case"
if { $timetol <= 2 } {
+ verbose -log "Timed out with retry (timeout = $timeout)"
incr timetol
exp_continue
} else {
+ warning "Timed out executing testcase (timeout = $timeout)"
catch close
return "Timed out executing test case"
}
}
- -re "^$prefix\r\n" {
- exp_continue
- }
}
- # Use "wait" before "close": valgrind might not have finished
- # writing the log out before we parse it, so we need to wait for
- # the spawnee to finish.
-
- catch wait wres
- verbose "wres: $wres" 2
- verify_exit_status $executable $wres
-
+ # Use "wait" to pick up the sub-process exit state. If the sub-process is
+ # writing to a file (perhaps under valgrind) then that also needs to be
+ # complete; only attempt this on a valid spawn.
+ if { $sub_proc_id > 0 } {
+ verbose "waiting for $sub_proc_id" 1
+ # Be explicit about what we are waiting for.
+ catch "wait -i $sub_proc_id" wres
+ verbose "wres: $wres" 2
+ verify_exit_status $executable $wres
+ }
+
if $run_under_valgrind {
upvar 2 name name
parse_valgrind_logfile $name $valgrind_logfile