unix.exp

# The values in this file can be overridden by creating localcfg.exp 
# and setting them there.  This is useful if you are working against
# the CVS repository and make a purely local change (such as setting
# the timeout value to a low value).

# Set this to 1 to cause the test suite to wait while you attach to
# the process that is being tested.

if { ![info exists ATTACH] } {
    set ATTACH no
}

if { ![info exists MEMTRACE] } {
    set MEMTRACE /dev/null
}

if { ![info exists DBCK_MEMTRACE] } {
    set DBCK_MEMTRACE /dev/null
}

if { ![info exists EFENCE] } {
    set EFENCE 0
}

# The attach option

if { $ATTACH == "yes" } {
    set attach 1
} else {
    set attach 0
}

# Set this to 1 if test-l2g was linked with Electric Fence.
if { $EFENCE == "yes" } {
    set efence 1
} else {
    set efence 0
}

# Set MEMTRACE to the file where the trace should be sent.
# This is typically the tty where you are running the attached gdb.

# Some of the machines we run the Xenofarm tests on are really, really
# slow, so we have to increase the timeout.
set timeout [expr {3 * $timeout}]

# Set the timeout value to something small for quicker testing, if you
# have a fast enough machine.
#set timeout 5

# 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\]*"
# 1970-01-01 GMT, but with some fuzziness to allow for local time zones.
set epoch_time "0 0 \[0-9\]* (1|31) (0|11) (70|69) (4|3) (0|364) \[01\]"
set any_num "\[0-9\]\[0-9\]*"

# The port that is used for Protocol A connections by the test suite.
set clientport 53262

set aux_item_default_conf_file "$top_srcdir/run-support/aux-items.conf"

# Fix the tty settings for minimum impact on the data flow.
set stty_init "-echo -onlcr -istrip -isig erase '^-' kill '^-' werase '^-'"

# State variables.
set line_leader ""
set meta_line_leader ""

# Values that show up in protocol messages
set lyskomd_host [exec python -c "import socket\nprint socket.gethostbyaddr(\"127.0.0.1\")\[0\]"]

# valgrind support
set valgrindix 0

# Recursive lock count.
set lock_count 0

proc efence_blurb {} {
    global efence

    if {$efence} {
	simple_expect "" "efence blank line"
	simple_expect "  Electric Fence .* Copyright .* Bruce Perens." \
		"efence init"
    }
}

proc obtain_lock {} {
    global lock_count
    global nl
    global spawn_id
    global lock_id
    global any
    global srcdir

    if {$lock_count == 0} {
	set redo 1
	while {$redo} {
	    spawn python $srcdir/locksuite.py
	    set lock_id $spawn_id
	    expect {
		-re "^locking...$nl" {
		    exp_continue
		}
		-re "^waiting: socket (.*)$nl" {
		    warning "Test suite locked by socket $expect_out(1,string)" 0
		    exp_continue
		}
		-re "^waiting: file (.*)$nl" {
		    warning "Test suite locked by file $expect_out(1,string)" 0
		    exp_continue
		}
		-re "^failed: file ($any*) (\[^ :\]*):(\[0-9\]*)$nl" {
		    warning "failed to obtain lock due to $expect_out(1,string)"
		    warning "removing stale lock $expect_out(1,string)"
		    system "rm $expect_out(1,string)"
		    send "exit\n"
		    expect bye
		    expect eof
		    wait
		}
		-re "^locked$nl" {
		    set redo 0
		}
		timeout {
		    exp_continue
		}
		eof {
		    fail "obtaining lock failed"
		    wait
		    set redo 0
		}
	    }
	}
    }
    set lock_count [expr {$lock_count + 1}]
}

proc release_lock {} {
    global lock_count
    global nl
    global spawn_id
    global lock_id

    if {$lock_count == 1} {
	set spawn_id $lock_id
	send "exit\n"
	expect {
	    -re "queued: socket (.*)$nl" {
		warning "Test suite blocked for $expect_out(1,string)" 0
		exp_continue
	    }
	    -re "bye$nl"
	}
	expect eof
	wait
    }
    if {$lock_count < 1} {
	error "lock already unlocked"
    } else {
	set lock_count [expr {$lock_count - 1}]
    }
}

proc l2g_start {} {
    global spawn_id
    global l2g
    global efence
    global l2g_id
    global deep_any
    global nl
    global expect_active
    global expect_always
    global test
    global MEMTRACE
    global valgrind

    obtain_lock

    if {$valgrind != ""} {
	spawn ./valgrind.wrap valgrind-l2g.log --suppressions=lyskomd.supp --num-callers=40 --leak-check=yes --logfile-fd=25 --show-reachable=yes $l2g
    } else {
	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)')\" } timeout { fail \"\$test (timeout on l2g)\" }"
    set expect_always($l2g_id) \
	    " -i $l2g_id full_buffer { fail \"\$test (full_buffer on l2g)\" }"

    talk_to l2g

    set test "starting l2g"
    expect {
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
            exp_continue
	}
	-re "^l2g> " {
	    pass "$test"
	}
    }
    unset test
    send "\n"
    simple_expect "^EMPTY LINE" "noop command"

    if {$efence} {
	l2g_send "I9"
	l2g_send "a9 3 17"
	efence_blurb
    }
}

proc l2g_stop {} {
    global spawn_id

    l2g_send "q"
    simple_expect "test-l2g quitting"
    wait
    close
    check_valgrind valgrind-l2g.log 1 1 {}

    release_lock
}

proc l2g_send {str} {
    unanchored_expect "^l2g> " "prompt before $str"
    verbose "sending $str"
    send "$str\n"
}

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)"
    }

    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
    global verbose

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        

    if {$is_meta == "meta"} {
	set ll $meta_line_leader
    } else {
	set ll $line_leader
    }
    set test $testname
    if {$test == ""} {
	set test "looking for $regex"
    }
    if {[regexp "^(\[=%\])(\[0-9\]*)(( )(..*))?$" "$regex" all a refno]} {
	# This looks like a protocol A reply.
	expect {
	    -re "^$ll$regex$nl"    {pass "$test"}
	    -re "^$ll=$refno$nl"   {fail "$test (unexpected reply =$refno)"}

	    -re "^${ll}(\[=%\]$refno $any*)$nl" {
		fail "$test (unexpected reply $expect_out(1,string))"
	    }

	    timeout 	           {fail "$test (timeout)"}
	    eof 		   {fail "$test (eof)"; wait}
	    full_buffer 	   {fail "$test (full_buffer)"}
	}
    } else {
	expect {
	    -re "^$ll$regex$nl" {pass "$test"}
	    timeout 	        {fail "$test (timeout)"}
	    eof 		{fail "$test (eof)"; wait}
	    full_buffer 	{fail "$test (full_buffer)"}
	}
    }
    unset test
}

proc lyskomd_expect {regex} {
    global current_talk_what
    global current_talk_nr

    set what $current_talk_what
    set nr $current_talk_nr

    talk_to lyskomd
    simple_expect "$regex"
    talk_to $what $nr
}

proc good_bad_expect {good_regex bad_regex {xreason ""}} {
    global test
    global any
    global nl
    global line_leader
    global meta_line_leader
    global verbose

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        
    set ll $line_leader

    if {![regexp "^(\[=%\])(\[0-9\]*)(( )(..*))?$" "$good_regex" all first refno]} {
	fail "$test (broken good regex)"
	unset test
	return
    }
    set bad_regex "[string range "$bad_regex" 0 0]$refno [string range "$bad_regex" 1 end]"

    set test "looking for $good_regex (or $bad_regex)"

    expect {
	-re "^${ll}($good_regex)$nl"    {
	    if {$xreason != ""} {
		setup_xfail "*-*-*" "$xreason"
	    }
	    pass "$test (got $expect_out(1,string))"
	}
	-re "^$ll$bad_regex$nl"     {
	    if {$xreason != ""} {
		setup_xfail "*-*-*" "$xreason"
	    }
	    fail "$test (bad regex matches)"
	}
	-re "^${ll}(\[=%\]$refno $any*)$nl" {
	    fail "$test (unexpected reply $expect_out(1,string))"
	}

	timeout	           {fail "$test (timeout)"}
	eof 		   {fail "$test (eof)"; wait}
	full_buffer 	   {fail "$test (full_buffer)"}
    }
    unset test
}

proc extracting_expect {regex var grp} {
    global test
    global any
    global nl
    global line_leader
    global $var
    global verbose

    set test "looking for $regex"

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }

    set $var ""

    expect {
	-re "^$line_leader$regex$nl" {
	    set $var $expect_out($grp,string)
	    pass "$test"
	}
	timeout 	 {fail "$test (timeout)"}
	eof 		 {fail "$test (eof)"; wait}
	full_buffer 	{fail "$test (full_buffer)"}
    }
    unset test
}


proc unanchored_expect {regex testname} {
    global test
    global any
    global nl
    global verbose

    set test $testname

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        

    expect {
	-re "$regex" 	{pass "$test"}
	timeout 	{fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
	-re "($any*)$nl" {
	    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')"
	}
    }
    unset test
}

proc spawn_lyskomd {logfile arg} {
    global valgrind
    global spawn_id

    set cmd "spawn"
    if {$valgrind != ""} {
	set cmd "$cmd ./valgrind.wrap"
	set cmd "$cmd $logfile"
	# set cmd "$cmd -v"
	set cmd "$cmd --num-callers=40"
	set cmd "$cmd --suppressions=lyskomd.supp"
	set cmd "$cmd --leak-check=yes"
	set cmd "$cmd --logfile-fd=25"
	set cmd "$cmd --show-reachable=yes"
    }
    set cmd "$cmd ../lyskomd"
    if { $arg == "" } {
	set cmd "$cmd -f config/lyskomd-config"
    } else {
	set cmd "$cmd $arg"
    }
    set pid [eval $cmd]
    return $pid
}

proc unpack_db {basename} {
    global srcdir

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f

    system "rm -rf db etc"
    system "mkdir db etc"
    system "cp $srcdir/lyskomd.0/$basename.data db/lyskomd-data"
    system "cp $srcdir/lyskomd.0/$basename.texts db/lyskomd-texts"
    system "chmod 644 db/lyskomd-data db/lyskomd-texts"
    if {[file exists "$srcdir/lyskomd.0/$basename.nr"]} {
	system "cp $srcdir/lyskomd.0/$basename.nr db/number.txt"
	system "chmod 644 db/number.txt"
    }
}

proc lyskomd_start {{aux_item_conf_file ""} \
	{extra_config ""} \
	{base_config ""} \
	{args ""} \
	{db_suffix ""} \
	{log_messages {}} \
	{init_db 1} \
	{want_stale 0} \
	{confs 6} \
	{texts 1} \
	{nogarb 0}} {

    global spawn_id
    global server_id
    global test
    global deep_any
    global nl
    global attach
    global timeout
    global expect_active
    global expect_always
    global clientport
    global aux_item_default_conf_file
    global lyskomd_pid
    global top_srcdir
    global debug_calls
    global mem_trace
    global MEMTRACE
    global line_leader
    global any

    obtain_lock

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f
    if {$init_db} {
	system "rm -rf db etc"
	system "mkdir db etc"
	system "cp $top_srcdir/db-crypt/db/lyskomd-data$db_suffix db/lyskomd-data"
	system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
	system "cp $top_srcdir/db-crypt/db/number.txt db/"
	system "chmod 644 db/lyskomd-data db/lyskomd-texts db/number.txt"
    }

    set cf [open "config/lyskomd-config" "w"]
    puts $cf "Client port: $clientport"
    puts $cf "Prefix: [pwd]"
    if { $base_config == "" } {
        if { [regexp -nocase "Max conferences" $extra_config] == 0 } {
            puts $cf "Max conferences: 2000"
        }
        if { [regexp -nocase "Max texts" $extra_config] == 0 } {
            puts $cf "Max texts: 20000"
        }
        puts $cf "Aux-item definition file: $aux_item_conf_file"
    } else {
        puts $cf $base_config
    }
    puts $cf $extra_config
    close $cf

    set pid [spawn_lyskomd valgrind-lyskomd.log $args]
    set lyskomd_pid $pid

    set server_id $spawn_id
    set expect_active($server_id) \
	    " -i $server_id -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line from lyskomd: \$expect_out(1,string))\"; exp_continue } -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait } timeout { fail \"\$test (timeout on lyskomd)\" }"
    set expect_always($server_id) \
	    " -i $server_id full_buffer { fail \"\$test (full_buffer on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"

    talk_to lyskomd
    set test "server started"
    set t $timeout
    set timeout [expr {2 * $timeout}]
    set debug_calls 0
    set mem_trace 0
    set unattached $attach
    expect {
	-re "^Where does the trace want to go today. .stderr." {
	    pass "Tracing is activated ($MEMTRACE)"
	    if {$unattached} {
		send_user "Please attach to lyskomd pid $pid and hit RETURN\n"
		set timeout 3600
		set t 3600
		expect_user {
		    -re .
		}
		send_user "Continuing with timeout set to $timeout\n"
		set unattached 0
	    }
	    send "$MEMTRACE\n"
	    set mem_trace 1
            exp_continue
	}
	-re "^${line_leader}... Version $any* .process $any*. started.$nl" {
	}
	timeout         {fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
    }

    set stale 0
    set test "Lock created"
    expect {
	-re "^${line_leader}WARNING: This server was compiled with --with-debug-calls\\.$nl" {
	    expect -re "^${line_leader}It isn.t safe to use in a production environment.$nl"
	    pass "debug calls are enabled"
	    set debug_calls 1
            exp_continue
	}
	-re "^${line_leader}Removed stale lock file left by ($any*):($any*).$nl" {
	    if {$stale == 1} {
		fail "$test (more than one stale lock file removed)"
	    } elseif {$want_stale == 0} {
		fail "$test (lyskomd removed a stale lock file)"
	    }
	    set stale 1
	    exp_continue
	}
	-re "^${line_leader}Created lock ($any*)$nl" {
	    pass "$test (lock file $expect_out(1,string)"
	}
	timeout         {fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
    }   
    set timeout $t
    if {$stale == 0 && $want_stale == 1} {
	fail "$test (no stale lock file removed)"
    }
    unset test

    simple_expect "Listening for clients on $clientport."
    simple_expect "Database = [pwd]/db/lyskomd-data"
    simple_expect "Backup = [pwd]/db/lyskomd-backup"
    simple_expect "2nd Backup = [pwd]/db/lyskomd-backup-prev"
    simple_expect "Lock File = [pwd]/db/lyskomd-lock"
    simple_expect "MSG: init_cache: using datafile."
    simple_expect "Database saved on $any*"
    simple_expect "Read $confs confs/persons and $texts texts"

    foreach logmsg $log_messages {
	simple_expect "$logmsg"
    }

    if {$nogarb == 0} {
	simple_expect "MSG: garb started."
	simple_expect "MSG: garb ready. 0 texts deleted."
    }

    if {$unattached} {
	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_fail_start {log_messages
			 {aux_item_conf_file "" }
                         {extra_config ""}
                         {base_config ""}
                         {args ""}} {
    global spawn_id
    global server_id
    global test
    global deep_any
    global any
    global nl
    global line_leader
    global timeout
    global expect_active
    global expect_always
    global clientport
    global aux_item_default_conf_file
    global lyskomd_pid
    global top_srcdir
    global MEMTRACE
    global debug_calls

    obtain_lock

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f
    system "rm -rf db etc"
    system "mkdir db etc"
    system "cp $top_srcdir/db-crypt/db/lyskomd-data db/"
    system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
    system "cp $top_srcdir/db-crypt/db/number.txt db/"

    set cf [open "config/lyskomd-config" "w"]
    puts $cf "Client port: $clientport"
    if { $base_config == "" } {
        puts $cf "Max conferences: 2000"
        puts $cf "Max texts: 2000"
        puts $cf "Prefix: [pwd]"
        puts $cf "Aux-item definition file: $aux_item_conf_file"
    } else {
        puts $cf $base_config
    }
    puts $cf $extra_config
    close $cf

    set pid [spawn_lyskomd valgrind-lyskomdfail.log $args]
    set lyskomd_pid $pid

    set server_id $spawn_id
    set expect_active($server_id) \
	    " -i $server_id -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line from lyskomd: \$expect_out(1,string))\"; exp_continue } -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait } timeout { fail \"\$test (timeout on lyskomd)\" }"
    set expect_always($server_id) \
	    " -i $server_id full_buffer { fail \"\$test (full_buffer on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"

    talk_to lyskomd
    set test "server start failed"
    set t $timeout
    set timeout [expr {2 * $timeout}]
    
    expect {
	-re "^Where does the trace want to go today. .stderr." {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
            exp_continue
	}
	-re "^${line_leader}... Version $any* .process $any*. started.$nl" {
	}
	timeout         {fail "$test (timeout)" }
	full_buffer 	{fail "$test (full_buffer)" }
	eof 		{fail "$test (eof)"; wait}
    }

    set debug_calls 0
    expect {
	-re "^${line_leader}WARNING: This server was compiled with --with-debug-calls\\.$nl" {
	    expect -re "^${line_leader}It isn.t safe to use in a production environment.$nl"
	    pass "debug calls are enabled"
	    set debug_calls 1
            exp_continue
	}
	-notransfer -re "^${line_leader}."
    }

    foreach logmsg $log_messages {
	simple_expect "$logmsg"
    }
    simple_expect "Previous message is fatal. Will dump core now."
    simple_expect "Search for the core in [pwd]"

    set timeout $t

    set test "server died"
    expect {
        timeout   { fail "$test (timeout)" }
        eof       { pass "$test"; wait }
    }
    check_valgrind valgrind-lyskomdfail.log 0 0 {}

    release_lock
}

proc check_memory_usage {} {
    set allocated_strings 0
    set allocated_blocks 0

    set f [ open "etc/memory-usage" ]
    while { [ gets $f line] >= 0 } {
        if { [regexp "Allocated blocks .grand total." $line] } {
            set allocated_blocks [lindex "$line" [expr [llength "$line"] - 1]]
        } elseif { [regexp "Allocated strings" $line] } {
            set allocated_strings [lindex "$line" [expr [llength "$line"] - 1]]
        }
    }
    close $f

    if { $allocated_blocks != 0 } {
        fail "Allocated blocks on exit"
    } else {
        pass "Allocated blocks on exit"
    }
    if { $allocated_strings != 0 } {
        fail "Allocated strings on exit"
    } else {
        pass "Allocated strings on exit"
    }
}

proc parse_valgrind_leak {f} {
    if {[gets $f line] < 0} {
	fail "valgrind EOF in leak summary"
	return 999
    }
    if {[regexp ":  *\[0-9\]* bytes in (\[0-9\]*) block" "$line" all blocks]} {
	return $blocks
    }
    fail "valgrind leak report parse error"
    return 998
}

proc check_valgrind {logfile need_leaks need_errs expected_leaks} {
    # The "expected_leaks" argument should be a such as:
    #
    #   {"Bug 99 & Bug 93" 4 3 9}
    #
    # that indicates that due to Bug 99 and Bug 93 there will be 4
    # definite leaks, 3 possible leaks, and 9 still reachable blocks.
    
    global valgrindix
    global valgrind
    global test

    if {$valgrind == ""} {
	return
    }

    set errfound 0
    set memfound 0
    set errcount 0
    set leakcount 0

    # Rename the file.  $saved holds the new name.
    while {[file exists "valgrind-$valgrindix.log"]} {
	set valgrindix [expr $valgrindix + 1]
    }
    set saved "valgrind-$valgrindix.log"
    system "mv $logfile $saved"

    # Should the log file be kept?
    set keep 0

    set f [open $saved]
    while {[gets $f line] >= 0} {
	if {[regexp "ERROR SUMMARY: (\[0-9\]*) errors" $line match errs]} {
	    if {$errfound} {
		fail "check_valgrind logic error due to $saved"
		set keep 1
	    } else {
		set errfound 1
		set errcount $errs
	    }
	}
	if {[regexp "LEAK SUMMARY:" $line]} {
	    set memfound 1
	    set definite [parse_valgrind_leak $f]
	    set possible [parse_valgrind_leak $f]
	    set reachable [parse_valgrind_leak $f]
	    if {$expected_leaks != {}} {
		set xreason [lindex $expected_leaks 0]
		set exp_def [lindex $expected_leaks 1]
		set exp_pos [lindex $expected_leaks 2]
		set exp_rea [lindex $expected_leaks 3]

		setup_xfail "*-*-*" $xreason
		if {$exp_def == $definite
		    && $exp_pos == $possible
		    && $exp_rea == $reachable} {

		    fail "memory leaks: $definite definite, $possible possible"
		    
		    set definite 0
		    set possible 0
		    set reachable 0
		} else {
		    pass "wrong memory leak count found"
		}
	    }
	    set leakcount [expr $definite + $possible]
	    # Ignore up to 10 reachable blocks.  libc leaks some blocks...
	    if {$reachable > 10} {
		set leakcount "$reachable"
	    }
	}
	if {[regexp "No malloc'd blocks -- no leaks are possible" $line]} {
	    set memfound 1
	}
    }
    close $f
    if {$errfound == 0 && $need_errs == 1} {
	fail "no error summary in valgrind output $saved"
	set keep 1
    }

    if {$memfound == 0 && $need_leaks == 1} {
	fail "no malloc summary in valgrind output $saved"
	set keep 1
    }

    if {$errcount == 0} {
	pass "valgrind found no errors"
    } else {
	fail "valgrind found $errcount error(s).  See $saved."
	set keep 1
    }
    if {$leakcount == 0} {
	pass "valgrind found no leaks"
    } else {
	if {$definite} {
	    fail "valgrind found $definite definite leaks.  See $saved."
	    set keep 1
	}
	if {$possible} {
	    fail "valgrind found $possible possible leaks.  See $saved."
	    set keep 1
	}
	if {$reachable} {
	    fail "valgrind found $reachable reachable blocks.  See $saved."
	    set keep 1
	}
    }

    if {$keep == 0} {
	system rm $saved
    }
}

proc lyskomd_death {{expected_leaks {}} {reason 5}} {
    # See check_valgrind for a description of "expected_leaks".
    global spawn_id
    global server_id
    global test
    global any
    global nl
    global expect_active
    global expect_always

    talk_to lyskomd
    if {$reason == "signal"} {
	simple_expect "Signal HUP received. Shutting down server."
    } else {
	simple_expect "shutdown initiated by person $reason $any*"
    }
    simple_expect "../lyskomd terminated normally."
    simple_expect "Press enter to terminate lyskomd"
    send "\n"
    set test "server died"
    expect {
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
    unset expect_active($server_id)
    unset expect_always($server_id)
    unset spawn_id
    fix_expect_after

    system "cat etc/memory-usage >> usage.all"
    check_memory_usage
    check_valgrind valgrind-lyskomd.log 1 1 $expected_leaks
    dbck_run

    release_lock
}

proc kill_lyskomd {} {
    global lyskomd_pid
    global test
    global spawn_id
    global expect_active
    global expect_always
    global server_id

    talk_to lyskomd
    system "kill -KILL $lyskomd_pid"
    set test "server died"
    expect {
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
    unset expect_active($server_id)
    unset expect_always($server_id)
    unset spawn_id
    fix_expect_after

    release_lock
}

proc dbck_run {} {
    global nl
    global test
    global any_num
    global DBCK_MEMTRACE
    global valgrind
    global spawn_id

    if {$valgrind != ""} {
	spawn ./valgrind.wrap valgrind-dbck.log --suppressions=lyskomd.supp --num-callers=40 --logfile-fd=25 --show-reachable=yes ../dbck -d config/lyskomd-config
    } else {
	spawn ../dbck -d config/lyskomd-config
    }
    set test "dbck started"
    expect_after {
	timeout { fail "$test (timeout)" }
	eof { fail "$test (eof)" }
    }
    expect {
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($DBCK_MEMTRACE)"
	    send "$DBCK_MEMTRACE\n"
            exp_continue
	}
	-re "^MSG: init_cache: using datafile\.$nl" { 
            pass "$test" 
        }
    }

    set test "dbck sent second line"
    expect {
	-re "^Read $any_num confs/persons and $any_num texts, eof at $any_num$nl" {
	    pass "$test"
	}
    }
    set test "dbck sent final line"
    expect {
	-re "^Press enter to terminate dbck$nl" {
	    pass "$test"
	}
    }
    send "\n"
    set test "dbck died"
    expect {
	eof { pass "$test"; wait }
    }