}
close $fd
} e]} {
- puts -nonewline "."
+ if {$::verbose} {
+ puts -nonewline "."
+ }
} else {
- puts -nonewline "ok"
+ if {$::verbose} {
+ puts -nonewline "ok"
+ }
}
return $retval
}
set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
if {$::valgrind} {
- exec valgrind src/redis-server $config_file > $stdout 2> $stderr &
+ exec valgrind --suppressions=src/valgrind.sup src/redis-server $config_file > $stdout 2> $stderr &
} else {
exec src/redis-server $config_file > $stdout 2> $stderr &
}
set retrynum 20
set serverisup 0
- puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+ if {$::verbose} {
+ puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+ }
+
after 10
if {$code ne "undefined"} {
while {[incr retrynum -1]} {
} else {
set serverisup 1
}
- puts {}
+
+ if {$::verbose} {
+ puts ""
+ }
if {!$serverisup} {
error_and_quit $config_file [exec cat $stderr]
reconnect
# execute provided block
- set curnum $::testnum
- if {![catch { uplevel 1 $code } err]} {
- # zero exit status is good
- unset err
+ set num_tests $::num_tests
+ if {[catch { uplevel 1 $code } error]} {
+ set backtrace $::errorInfo
+
+ # Kill the server without checking for leaks
+ dict set srv "skipleaks" 1
+ kill_server $srv
+
+ # Print warnings from log
+ puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]]
+ set warnings [warnings_from_file [dict get $srv "stdout"]]
+ if {[string length $warnings] > 0} {
+ puts "$warnings"
+ } else {
+ puts "(none)"
+ }
+ puts ""
+
+ error $error $backtrace
}
- if {$curnum == $::testnum} {
- # don't check for leaks when no tests were executed
+ # Don't do the leak check when no tests were run
+ if {$num_tests == $::num_tests} {
dict set srv "skipleaks" 1
}
# pop the server object
set ::servers [lrange $::servers 0 end-1]
-
- # allow an exception to bubble up the call chain but still kill this
- # server, because we want to reuse the ports when the tests are re-run
- if {[info exists err]} {
- if {$err eq "exception"} {
- puts [format "Logged warnings (pid %d):" [dict get $srv "pid"]]
- set warnings [warnings_from_file [dict get $srv "stdout"]]
- if {[string length $warnings] > 0} {
- puts "$warnings"
- } else {
- puts "(none)"
- }
- # kill this server without checking for leaks
- dict set srv "skipleaks" 1
- kill_server $srv
- error "exception"
- } elseif {[string length $err] > 0} {
- puts "Error executing the suite, aborting..."
- puts $err
- exit 1
- }
- }
set ::tags [lrange $::tags 0 end-[llength $tags]]
kill_server $srv
set ::port 16379
set ::traceleaks 0
set ::valgrind 0
+ set ::verbose 0
set ::denytags {}
set ::allowtags {}
set ::external 0; # If "1" this means, we are running against external instance
set ::file ""; # If set, runs only the tests in this comma separated list
+ set ::curfile ""; # Hold the filename of the current suite
proc execute_tests name {
- source "tests/$name.tcl"
+ set path "tests/$name.tcl"
+ set ::curfile $path
+ source $path
}
# Setup a list to hold a stack of server configs. When calls to start_server
}
cleanup
- puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
- if {$::failed > 0} {
- puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
+ puts "\n[expr $::num_tests] tests, $::num_passed passed, $::num_failed failed\n"
+ if {$::num_failed > 0} {
+ set curheader ""
+ puts "Failures:"
+ foreach {test} $::tests_failed {
+ set header [lindex $test 0]
+ append header " ("
+ append header [join [lindex $test 1] ","]
+ append header ")"
+
+ if {$curheader ne $header} {
+ set curheader $header
+ puts "\n$curheader:"
+ }
+
+ set name [lindex $test 2]
+ set msg [lindex $test 3]
+ puts "- $name: $msg"
+ }
+
+ puts ""
exit 1
}
}
}
}
incr j
+ } elseif {$opt eq {--valgrind}} {
+ set ::valgrind 1
} elseif {$opt eq {--file}} {
set ::file $arg
incr j
} elseif {$opt eq {--port}} {
set ::port $arg
incr j
+ } elseif {$opt eq {--verbose}} {
+ set ::verbose 1
} else {
puts "Wrong argument: $opt"
exit 1
if {[string length $err] > 0} {
# only display error when not generated by the test suite
if {$err ne "exception"} {
- puts $err
+ puts $::errorInfo
}
exit 1
}