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

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index ead81e9eeabf804b5897f6bb51b55c2280c664d0..8adce3e8754ca5acaebd88556b3b1e2f829199df 100644 (file)
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -103,23 +103,25 @@ proc start_server {filename overrides {code undefined}} {
     }
 
     # setup config dict
     }
 
     # 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"} {
 
     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
 
         
         # 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..."
 
         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 {
             exit 1
         }
     } else {

-        set _ $ret
+        set _ $srv

     }
 }
     }
 }

diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index cd8d65a1c16c4cac0e254a69b24dfc8685cbc2a1..49dfb16388b0630470cff676c24a3cba88312384 100644 (file)
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -18,12 +18,35 @@ proc execute_tests name {
     source "tests/$name.tcl"
 }
 
     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} {
 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 {} {
 }
 
 proc main {} {