store entire server object on the stack instead of just the client

This commit is contained in:
Pieter Noordhuis 2010-05-14 20:50:32 +02:00
parent 9cf9e6f197
commit 1c4114be40
2 changed files with 41 additions and 16 deletions

View File

@ -103,23 +103,25 @@ proc start_server {filename overrides {code undefined}} {
}
# setup config dict
dict set ret "config" $config_file
dict set ret "pid" $pid
dict set ret "stdout" $stdout
dict set ret "stderr" $stderr
dict set ret "client" $client
dict set srv "config" $config_file
dict set srv "pid" $pid
dict set srv "host" $host
dict set srv "port" $port
dict set srv "stdout" $stdout
dict set srv "stderr" $stderr
dict set srv "client" $client
if {$code ne "undefined"} {
# append the client to the client stack
lappend ::clients $client
# append the server to the stack
lappend ::servers $srv
# execute provided block
catch { uplevel 1 $code } err
# pop the client object
set ::clients [lrange $::clients 0 end-1]
# pop the server object
set ::servers [lrange $::servers 0 end-1]
kill_server $ret
kill_server $srv
if {[string length $err] > 0} {
puts "Error executing the suite, aborting..."
@ -127,6 +129,6 @@ proc start_server {filename overrides {code undefined}} {
exit 1
}
} else {
set _ $ret
set _ $srv
}
}

View File

@ -18,12 +18,35 @@ proc execute_tests name {
source "tests/$name.tcl"
}
# setup a list to hold a stack of clients. the proc "r" provides easy
# access to the client at the top of the stack
set ::clients {}
# Setup a list to hold a stack of server configs. When calls to start_server
# are nested, use "srv 0 pid" to get the pid of the inner server. To access
# outer servers, use "srv -1 pid" etcetera.
set ::servers {}
proc srv {level property} {
set srv [lindex $::servers end+$level]
dict get $srv $property
}
# Provide easy access to the client for the inner server. It's possible to
# prepend the argument list with a negative level to access clients for
# servers running in outer blocks.
proc r {args} {
set client [lindex $::clients end]
$client {*}$args
set level 0
if {[string is integer [lindex $args 0]]} {
set level [lindex $args 0]
set args [lrange $args 1 end]
}
[srv $level "client"] {*}$args
}
# Provide easy access to INFO properties. Same semantic as "proc r".
proc s {args} {
set level 0
if {[string is integer [lindex $args 0]]} {
set level [lindex $args 0]
set args [lrange $args 1 end]
}
status [srv $level "client"] [lindex $args 0]
}
proc main {} {