diff --git a/src/server/testsuite/config/unix.exp b/src/server/testsuite/config/unix.exp
index 0c4973eb5343a81a773a90278ea40fe5e4ef4ed5..510d9fed1e0bd3728d13706a90bb3a651e578ee0 100644
--- a/src/server/testsuite/config/unix.exp
+++ b/src/server/testsuite/config/unix.exp
@@ -1,7 +1,16 @@
+# Set this to 1 to cause the test suite to wait while you attach to
+# the process that is being tested.
+set attach 0
+
+# Set this to 1 if test-l2g was linked with Electric Fence.
+set efence 0
+
+# Some useful constants.
set nl "\r?\n"
set any "\[ -�\]"
set deep_any "\\\[ -�\\\]"
set hollerith "\[0-9\]*H$any*"
+set any_time "\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*"
set maxint 2147483647
@@ -10,9 +19,12 @@ set maxint 2147483647
set clientport 53262
set muxport 53263
+# Fix the tty settings for minimum impact on the data flow.
set stty_init "-echo -onlcr -ocrnl -istrip"
-set efence 0
+# State variables.
+set line_leader ""
+set meta_line_leader ""
proc efence_blurb {} {
global efence
@@ -28,8 +40,18 @@ proc l2g_start {} {
global spawn_id
global l2g
global efence
+ global l2g_id
+ global deep_any
+ global nl
spawn $l2g
+ set l2g_id $spawn_id
+ set expect_active($l2g_id) \
+ " -i $l2g_id eof { fail \"\$test (eof on l2g); wait\" } -re \"^($deep_any*)$nl\" { fail \"\$test (unexpected line '\$expect_out(1,string)')\" } -re \"($deep_any*)l2g> \" { fail \"\$test (unexpected incomplete line '\$expect_out(1,string)')\" } "
+ set expect_always($l2g_id) \
+ " -i $l2g_id buffer_full { fail \"\$test (buffer_full on l2g)\" }"
+
+ talk_to l2g
if {$efence} {
l2g_send "I9"
@@ -53,26 +75,47 @@ proc l2g_send {str} {
send "$str\n"
}
-proc simple_expect {regex {testname ""}} {
+proc fix_expect_after {} {
+ global expect_always
+ global expect_active
+ global spawn_id
+
+ set stmt "expect_after"
+
+ foreach k [array names expect_always] {
+ set stmt "$stmt $expect_always($k)"
+ }
+
+ if {[info exists spawn_id] && [info exists expect_active($spawn_id)]} {
+ set stmt "$stmt $expect_active($spawn_id)"
+ }
+
+ set stmt "$stmt timeout { fail \"\$test (timeout)\" }"
+ verbose "evaluating $stmt" 2
+ eval $stmt
+}
+
+proc simple_expect {regex {testname ""} {is_meta ""}} {
global test
global any
global nl
+ global line_leader
+ global meta_line_leader
+ if {$is_meta == "meta"} {
+ set ll $meta_line_leader
+ } else {
+ set ll $line_leader
+ }
set test $testname
if {$test == ""} {
set test "looking for $regex"
}
expect {
- -re "^$regex$nl" {pass "$test"}
+ -re "^$ll$regex$nl" {pass "$test"}
timeout {fail "$test (timeout)"}
eof {fail "$test (eof)"; wait}
buffer_full {fail "$test (buffer_full)"}
- -re "($any*)$nl" {
- fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
- }
- -re "($any*)l2g> " {
- fail "$test (unexpected incomplete line '$expect_out(1,string)' waiting for '$regex')"
- }
}
unset test
}
@@ -89,11 +132,11 @@ proc unanchored_expect {regex testname} {
buffer_full {fail "$test (buffer_full)"}
eof {fail "$test (eof)"; wait}
-re "($any*)$nl" {
- fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
+ fail "$test (unexpected line '\$expect_out(1,string)' waiting for '$regex')"
exp_continue
}
-re "($any*)l2g>" {
- fail "$test (unexpected incomplete line '$expect_out(1,string)' waiting for '$regex')"
+ fail "$test (unexpected incomplete line '\$expect_out(1,string)' waiting for '$regex')"
}
}
unset test
@@ -104,11 +147,17 @@ proc lyskomd_start {} {
global server_id
global test
global nl
+ global attach
+ global timeout
- spawn ../lyskomd -d config/lyskomd-config
+ set pid [spawn ../lyskomd -d config/lyskomd-config]
set server_id $spawn_id
set expect_active($server_id) ""
set expect_always($server_id) ""
+ set expect_active($server_id) \
+ " -i $server_id eof { fail \"\$test (eof on lyskomd); wait\" }"
+ set expect_always($server_id) \
+ " -i $server_id buffer_full { fail \"\$test (buffer_full on lyskomd)\" }"
talk_to lyskomd
set test "server started"
@@ -118,6 +167,15 @@ proc lyskomd_start {} {
buffer_full {fail "$test (buffer_full)"}
eof {fail "$test (eof)"; wait}
}
+
+ if {$attach} {
+ send_user "Please attach to lyskomd process $pid and press RETURN\n"
+ set timeout 3600
+ expect_user {
+ -re .
+ }
+ send_user "Continuing with timeout set to $timeout\n"
+ }
}
proc lyskomd_death {} {
@@ -141,25 +199,33 @@ proc client_start {nr} {
global spawn_id
global test
global nl
+ global expect_always
+ global expect_active
+ global srcdir
- spawn tcpconnect -rv localhost $clientport
+ spawn python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
set client_id($nr) $spawn_id
+ set expect_active($client_id($nr)) " "
+ set expect_always($client_id($nr)) \
+ " -i $client_id($nr) eof { fail \"\$test (eof on client$nr); wait\" } -i $client_id($nr) buffer_full { fail \"\$test (buffer_full on client$nr)\" } "
talk_to client $nr
- set test "client $nr started"
- expect {
- -re ".Connected to..*port $clientport.$nl" {pass "$test"}
- timeout {fail "$test (timeout)"}
- eof {fail "$test (eof)"}
- buffer_full {fail "$test (buffer_full)"}
- }
+ simple_expect "Connecting to localhost $clientport" \
+ "client connects" meta
+ simple_expect "Connected" "client connected" meta
}
proc talk_to {what {nr ""}} {
global spawn_id
global server_id
global client_id
+ global l2g_id
+ global line_leader
+ global meta_line_leader
+
+ set line_leader ""
+ set meta_line_leader ""
switch $what {
lyskomd {
@@ -167,13 +233,23 @@ proc talk_to {what {nr ""}} {
}
client {
set spawn_id $client_id($nr)
+ set line_leader "MRK:client$nr"
+ }
+ l2g {
+ set spawn_id $l2g_id
}
default {
error "attempting to talk to $what"
}
}
+ if {$line_leader != ""} {
+ set meta_line_leader "${line_leader}meta: "
+ set line_leader "${line_leader}: "
+ }
+
verbose "TALKING TO $spawn_id $what $nr"
+ fix_expect_after
}
proc holl {str} {