Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
ruanhaishen
redis
Commits
6f8a32d5
Commit
6f8a32d5
authored
Dec 10, 2010
by
Pieter Noordhuis
Browse files
Be less verbose in testing; improve error handling
parent
a5be65f7
Changes
5
Hide whitespace changes
Inline
Side-by-side
tests/support/server.tcl
View file @
6f8a32d5
...
...
@@ -83,9 +83,13 @@ proc ping_server {host port} {
}
close $fd
}
e
]}
{
puts -nonewline
"."
if
{
$::verbose
}
{
puts -nonewline
"."
}
}
else
{
puts -nonewline
"ok"
if
{
$::verbose
}
{
puts -nonewline
"ok"
}
}
return $retval
}
...
...
@@ -181,7 +185,10 @@ proc start_server {options {code undefined}} {
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
]}
{
...
...
@@ -196,7 +203,10 @@ proc start_server {options {code undefined}} {
}
else
{
set serverisup 1
}
puts
{}
if
{
$::verbose
}
{
puts
""
}
if
{
!$serverisup
}
{
error_and_quit $config_file
[
exec cat $stderr
]
...
...
@@ -246,41 +256,34 @@ proc start_server {options {code undefined}} {
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
"
\n
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)"
}
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
...
...
tests/support/test.tcl
View file @
6f8a32d5
set ::passed 0
set ::failed 0
set ::testnum 0
set ::num_tests 0
set ::num_passed 0
set ::num_failed 0
set ::tests_failed
{}
proc assert
{
condition
}
{
if
{
!
[
uplevel 1 expr $condition
]}
{
puts
"!! ERROR
\n
Expected '
$value
' to evaluate to true"
error
"assertion"
error
"assertion:Expected '
$value
' to be true"
}
}
proc assert_match
{
pattern value
}
{
if
{
!
[
string match $pattern $value
]}
{
puts
"!! ERROR
\n
Expected '
$value
' to match '
$pattern
'"
error
"assertion"
error
"assertion:Expected '
$value
' to match '
$pattern
'"
}
}
proc assert_equal
{
expected value
}
{
if
{
$expected
ne $value
}
{
puts
"!! ERROR
\n
Expected '
$value
' to be equal to '
$expected
'"
error
"assertion"
error
"assertion:Expected '
$value
' to be equal to '
$expected
'"
}
}
...
...
@@ -27,8 +25,7 @@ proc assert_error {pattern code} {
if
{[
catch
{
uplevel 1 $code
}
error
]}
{
assert_match $pattern $error
}
else
{
puts
"!! ERROR
\n
Expected an error but nothing was catched"
error
"assertion"
error
"assertion:Expected an error but nothing was catched"
}
}
...
...
@@ -47,7 +44,7 @@ proc assert_type {type key} {
assert_equal $type
[
r type $key
]
}
proc test
{
name code
{
okpattern
notspeci
fied
}}
{
proc test
{
name code
{
okpattern
unde
fi
n
ed
}}
{
# abort if tagged with a tag to deny
foreach tag $::denytags
{
if
{[
lsearch $::tags $tag
]
>= 0
}
{
...
...
@@ -69,30 +66,62 @@ proc test {name code {okpattern notspecified}} {
}
}
incr ::testnum
puts -nonewline
[
format
"#%03d %-68s "
$::testnum $name
]
flush stdout
incr ::num_tests
set details
{}
lappend details $::curfile
lappend details $::tags
lappend details $name
if
{
$::verbose
}
{
puts -nonewline
[
format
"#%03d %-68s "
$::num_tests $name
]
flush stdout
}
if
{[
catch
{
set retval
[
uplevel 1 $code
]}
error
]}
{
if
{
$error
eq
"assertion"
}
{
incr ::failed
if
{[
string match
"assertion:*"
$error
]}
{
set msg
[
string range $error 10 end
]
lappend details $msg
lappend ::tests_failed $details
incr ::num_failed
if
{
$::verbose
}
{
puts
"FAILED"
puts
"
$msg
\n
"
}
else
{
puts -nonewline
"F"
}
}
else
{
puts
"EXCEPTION"
puts
"
\n
Caught error:
$error
"
error
"exception"
# Re-raise, let handler up the stack take care of this.
error $error $::errorInfo
}
}
else
{
if
{
$okpattern
eq
"notspecified"
|| $okpattern eq $retval ||
[
string match $okpattern $retval
]}
{
puts
"PASSED"
incr ::passed
if
{
$okpattern
eq
"undefined"
|| $okpattern eq $retval ||
[
string match $okpattern $retval
]}
{
incr ::num_passed
if
{
$::verbose
}
{
puts
"PASSED"
}
else
{
puts -nonewline
"."
}
}
else
{
puts
"!! ERROR expected
\n
'
$okpattern
'
\n
but got
\n
'
$retval
'"
incr ::failed
set msg
"Expected '
$okpattern
' to equal or match '
$retval
'"
lappend details $msg
lappend ::tests_failed $details
incr ::num_failed
if
{
$::verbose
}
{
puts
"FAILED"
puts
"
$msg
\n
"
}
else
{
puts -nonewline
"F"
}
}
}
flush stdout
if
{
$::traceleaks
}
{
set output
[
exec leaks redis-server
]
if
{
!
[
string match
{
*0 leaks*
}
$output
]}
{
puts
"---
------ Test
$::testnum
LEAKED! -----
---"
puts
"---
Test
\"
$name
\"
leaked!
---"
puts $output
exit 1
}
...
...
tests/support/util.tcl
View file @
6f8a32d5
...
...
@@ -52,8 +52,10 @@ proc status {r property} {
proc waitForBgsave r
{
while 1
{
if
{[
status r bgsave_in_progress
]
eq 1
}
{
puts -nonewline
"
\n
Waiting for background save to finish... "
flush stdout
if
{
$::verbose
}
{
puts -nonewline
"
\n
Waiting for background save to finish... "
flush stdout
}
after 1000
}
else
{
break
...
...
@@ -64,8 +66,10 @@ proc waitForBgsave r {
proc waitForBgrewriteaof r
{
while 1
{
if
{[
status r bgrewriteaof_in_progress
]
eq 1
}
{
puts -nonewline
"
\n
Waiting for background AOF rewrite to finish... "
flush stdout
if
{
$::verbose
}
{
puts -nonewline
"
\n
Waiting for background AOF rewrite to finish... "
flush stdout
}
after 1000
}
else
{
break
...
...
tests/test_helper.tcl
View file @
6f8a32d5
...
...
@@ -13,13 +13,17 @@ set ::host 127.0.0.1
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
...
...
@@ -147,9 +151,27 @@ proc main {} {
}
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
}
}
...
...
@@ -177,6 +199,8 @@ for {set j 0} {$j < [llength $argv]} {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
...
...
@@ -187,7 +211,7 @@ if {[catch { main } err]} {
if
{[
string length $err
]
> 0
}
{
# only display error when not generated by the test suite
if
{
$err
ne
"exception"
}
{
puts $err
puts $
::
err
orInfo
}
exit 1
}
...
...
tests/unit/sort.tcl
View file @
6f8a32d5
...
...
@@ -144,8 +144,10 @@ start_server {
set sorted
[
r sort tosort BY weight_* LIMIT 0 10
]
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
if
{
$::verbose
}
{
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
}
}
test
"SORT speed,
$num
element list BY hash field, 100 times"
{
...
...
@@ -154,8 +156,10 @@ start_server {
set sorted
[
r sort tosort BY wobj_*->weight LIMIT 0 10
]
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
if
{
$::verbose
}
{
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
}
}
test
"SORT speed,
$num
element list directly, 100 times"
{
...
...
@@ -164,8 +168,10 @@ start_server {
set sorted
[
r sort tosort LIMIT 0 10
]
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
if
{
$::verbose
}
{
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
}
}
test
"SORT speed,
$num
element list BY <const>, 100 times"
{
...
...
@@ -174,8 +180,10 @@ start_server {
set sorted
[
r sort tosort BY nokey LIMIT 0 10
]
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
if
{
$::verbose
}
{
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
}
}
}
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment