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} {
...
@@ -83,9 +83,13 @@ proc ping_server {host port} {
}
}
close $fd
close $fd
}
e
]}
{
}
e
]}
{
puts -nonewline
"."
if
{
$::verbose
}
{
puts -nonewline
"."
}
}
else
{
}
else
{
puts -nonewline
"ok"
if
{
$::verbose
}
{
puts -nonewline
"ok"
}
}
}
return $retval
return $retval
}
}
...
@@ -181,7 +185,10 @@ proc start_server {options {code undefined}} {
...
@@ -181,7 +185,10 @@ proc start_server {options {code undefined}} {
set retrynum 20
set retrynum 20
set serverisup 0
set serverisup 0
puts -nonewline
"=== (
$tags
) Starting server
${::host}
:
${::port}
"
if
{
$::verbose
}
{
puts -nonewline
"=== (
$tags
) Starting server
${::host}
:
${::port}
"
}
after 10
after 10
if
{
$code
ne
"undefined"
}
{
if
{
$code
ne
"undefined"
}
{
while
{[
incr retrynum -1
]}
{
while
{[
incr retrynum -1
]}
{
...
@@ -196,7 +203,10 @@ proc start_server {options {code undefined}} {
...
@@ -196,7 +203,10 @@ proc start_server {options {code undefined}} {
}
else
{
}
else
{
set serverisup 1
set serverisup 1
}
}
puts
{}
if
{
$::verbose
}
{
puts
""
}
if
{
!$serverisup
}
{
if
{
!$serverisup
}
{
error_and_quit $config_file
[
exec cat $stderr
]
error_and_quit $config_file
[
exec cat $stderr
]
...
@@ -246,41 +256,34 @@ proc start_server {options {code undefined}} {
...
@@ -246,41 +256,34 @@ proc start_server {options {code undefined}} {
reconnect
reconnect
# execute provided block
# execute provided block
set curnum $::testnum
set num_tests $::num_tests
if
{
!
[
catch
{
uplevel 1 $code
}
err
]}
{
if
{[
catch
{
uplevel 1 $code
}
error
]}
{
# zero exit status is good
set backtrace $::errorInfo
unset err
# 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 do the leak check when no tests were run
# don't check for leaks when no tests were executed
if
{
$num
_tests == $::num_tests
}
{
dict set srv
"skipleaks"
1
dict set srv
"skipleaks"
1
}
}
# pop the server object
# pop the server object
set ::servers
[
lrange $::servers 0 end-1
]
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
]]
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
kill_server $srv
kill_server $srv
...
...
tests/support/test.tcl
View file @
6f8a32d5
set ::passed 0
set ::num_tests 0
set ::failed 0
set ::num_passed 0
set ::testnum 0
set ::num_failed 0
set ::tests_failed
{}
proc assert
{
condition
}
{
proc assert
{
condition
}
{
if
{
!
[
uplevel 1 expr $condition
]}
{
if
{
!
[
uplevel 1 expr $condition
]}
{
puts
"!! ERROR
\n
Expected '
$value
' to evaluate to true"
error
"assertion:Expected '
$value
' to be true"
error
"assertion"
}
}
}
}
proc assert_match
{
pattern value
}
{
proc assert_match
{
pattern value
}
{
if
{
!
[
string match $pattern $value
]}
{
if
{
!
[
string match $pattern $value
]}
{
puts
"!! ERROR
\n
Expected '
$value
' to match '
$pattern
'"
error
"assertion:Expected '
$value
' to match '
$pattern
'"
error
"assertion"
}
}
}
}
proc assert_equal
{
expected value
}
{
proc assert_equal
{
expected value
}
{
if
{
$expected
ne $value
}
{
if
{
$expected
ne $value
}
{
puts
"!! ERROR
\n
Expected '
$value
' to be equal to '
$expected
'"
error
"assertion:Expected '
$value
' to be equal to '
$expected
'"
error
"assertion"
}
}
}
}
...
@@ -27,8 +25,7 @@ proc assert_error {pattern code} {
...
@@ -27,8 +25,7 @@ proc assert_error {pattern code} {
if
{[
catch
{
uplevel 1 $code
}
error
]}
{
if
{[
catch
{
uplevel 1 $code
}
error
]}
{
assert_match $pattern $error
assert_match $pattern $error
}
else
{
}
else
{
puts
"!! ERROR
\n
Expected an error but nothing was catched"
error
"assertion:Expected an error but nothing was catched"
error
"assertion"
}
}
}
}
...
@@ -47,7 +44,7 @@ proc assert_type {type key} {
...
@@ -47,7 +44,7 @@ proc assert_type {type key} {
assert_equal $type
[
r 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
# abort if tagged with a tag to deny
foreach tag $::denytags
{
foreach tag $::denytags
{
if
{[
lsearch $::tags $tag
]
>= 0
}
{
if
{[
lsearch $::tags $tag
]
>= 0
}
{
...
@@ -69,30 +66,62 @@ proc test {name code {okpattern notspecified}} {
...
@@ -69,30 +66,62 @@ proc test {name code {okpattern notspecified}} {
}
}
}
}
incr ::testnum
incr ::num_tests
puts -nonewline
[
format
"#%03d %-68s "
$::testnum $name
]
set details
{}
flush stdout
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
{[
catch
{
set retval
[
uplevel 1 $code
]}
error
]}
{
if
{
$error
eq
"assertion"
}
{
if
{[
string match
"assertion:*"
$error
]}
{
incr ::failed
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
{
}
else
{
puts
"EXCEPTION"
# Re-raise, let handler up the stack take care of this.
puts
"
\n
Caught error:
$error
"
error $error $::errorInfo
error
"exception"
}
}
}
else
{
}
else
{
if
{
$okpattern
eq
"notspecified"
|| $okpattern eq $retval ||
[
string match $okpattern $retval
]}
{
if
{
$okpattern
eq
"undefined"
|| $okpattern eq $retval ||
[
string match $okpattern $retval
]}
{
puts
"PASSED"
incr ::num_passed
incr ::passed
if
{
$::verbose
}
{
puts
"PASSED"
}
else
{
puts -nonewline
"."
}
}
else
{
}
else
{
puts
"!! ERROR expected
\n
'
$okpattern
'
\n
but got
\n
'
$retval
'"
set msg
"Expected '
$okpattern
' to equal or match '
$retval
'"
incr ::failed
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
}
{
if
{
$::traceleaks
}
{
set output
[
exec leaks redis-server
]
set output
[
exec leaks redis-server
]
if
{
!
[
string match
{
*0 leaks*
}
$output
]}
{
if
{
!
[
string match
{
*0 leaks*
}
$output
]}
{
puts
"---
------ Test
$::testnum
LEAKED! -----
---"
puts
"---
Test
\"
$name
\"
leaked!
---"
puts $output
puts $output
exit 1
exit 1
}
}
...
...
tests/support/util.tcl
View file @
6f8a32d5
...
@@ -52,8 +52,10 @@ proc status {r property} {
...
@@ -52,8 +52,10 @@ proc status {r property} {
proc waitForBgsave r
{
proc waitForBgsave r
{
while 1
{
while 1
{
if
{[
status r bgsave_in_progress
]
eq 1
}
{
if
{[
status r bgsave_in_progress
]
eq 1
}
{
puts -nonewline
"
\n
Waiting for background save to finish... "
if
{
$::verbose
}
{
flush stdout
puts -nonewline
"
\n
Waiting for background save to finish... "
flush stdout
}
after 1000
after 1000
}
else
{
}
else
{
break
break
...
@@ -64,8 +66,10 @@ proc waitForBgsave r {
...
@@ -64,8 +66,10 @@ proc waitForBgsave r {
proc waitForBgrewriteaof r
{
proc waitForBgrewriteaof r
{
while 1
{
while 1
{
if
{[
status r bgrewriteaof_in_progress
]
eq 1
}
{
if
{[
status r bgrewriteaof_in_progress
]
eq 1
}
{
puts -nonewline
"
\n
Waiting for background AOF rewrite to finish... "
if
{
$::verbose
}
{
flush stdout
puts -nonewline
"
\n
Waiting for background AOF rewrite to finish... "
flush stdout
}
after 1000
after 1000
}
else
{
}
else
{
break
break
...
...
tests/test_helper.tcl
View file @
6f8a32d5
...
@@ -13,13 +13,17 @@ set ::host 127.0.0.1
...
@@ -13,13 +13,17 @@ set ::host 127.0.0.1
set ::port 16379
set ::port 16379
set ::traceleaks 0
set ::traceleaks 0
set ::valgrind 0
set ::valgrind 0
set ::verbose 0
set ::denytags
{}
set ::denytags
{}
set ::allowtags
{}
set ::allowtags
{}
set ::external 0
;
# If
"1"
this means, we are running against external instance
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 ::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
{
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
# Setup a list to hold a stack of server configs. When calls to start_server
...
@@ -147,9 +151,27 @@ proc main {} {
...
@@ -147,9 +151,27 @@ proc main {} {
}
}
cleanup
cleanup
puts
"
\n
[
expr $::passed+$::failed
]
tests,
$::passed
passed,
$::failed
failed"
puts
"
\n
[
expr $::num_tests
]
tests,
$::num
_passed passed,
$::num
_failed failed
\n
"
if
{
$::failed
> 0
}
{
if
{
$::num
_failed > 0
}
{
puts
"
\n
*** WARNING!!!
$::failed
FAILED TESTS ***
\n
"
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
exit 1
}
}
}
}
...
@@ -177,6 +199,8 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
...
@@ -177,6 +199,8 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
}
elseif
{
$opt
eq
{
--port
}}
{
}
elseif
{
$opt
eq
{
--port
}}
{
set ::port $arg
set ::port $arg
incr j
incr j
}
elseif
{
$opt
eq
{
--verbose
}}
{
set ::verbose 1
}
else
{
}
else
{
puts
"Wrong argument:
$opt
"
puts
"Wrong argument:
$opt
"
exit 1
exit 1
...
@@ -187,7 +211,7 @@ if {[catch { main } err]} {
...
@@ -187,7 +211,7 @@ if {[catch { main } err]} {
if
{[
string length $err
]
> 0
}
{
if
{[
string length $err
]
> 0
}
{
# only display error when not generated by the test suite
# only display error when not generated by the test suite
if
{
$err
ne
"exception"
}
{
if
{
$err
ne
"exception"
}
{
puts $err
puts $
::
err
orInfo
}
}
exit 1
exit 1
}
}
...
...
tests/unit/sort.tcl
View file @
6f8a32d5
...
@@ -144,8 +144,10 @@ start_server {
...
@@ -144,8 +144,10 @@ start_server {
set sorted
[
r sort tosort BY weight_* LIMIT 0 10
]
set sorted
[
r sort tosort BY weight_* LIMIT 0 10
]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
if
{
$::verbose
}
{
flush stdout
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"
{
test
"SORT speed,
$num
element list BY hash field, 100 times"
{
...
@@ -154,8 +156,10 @@ start_server {
...
@@ -154,8 +156,10 @@ start_server {
set sorted
[
r sort tosort BY wobj_*->weight LIMIT 0 10
]
set sorted
[
r sort tosort BY wobj_*->weight LIMIT 0 10
]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
if
{
$::verbose
}
{
flush stdout
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
}
}
}
test
"SORT speed,
$num
element list directly, 100 times"
{
test
"SORT speed,
$num
element list directly, 100 times"
{
...
@@ -164,8 +168,10 @@ start_server {
...
@@ -164,8 +168,10 @@ start_server {
set sorted
[
r sort tosort LIMIT 0 10
]
set sorted
[
r sort tosort LIMIT 0 10
]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
if
{
$::verbose
}
{
flush stdout
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
}
}
}
test
"SORT speed,
$num
element list BY <const>, 100 times"
{
test
"SORT speed,
$num
element list BY <const>, 100 times"
{
...
@@ -174,8 +180,10 @@ start_server {
...
@@ -174,8 +180,10 @@ start_server {
set sorted
[
r sort tosort BY nokey LIMIT 0 10
]
set sorted
[
r sort tosort BY nokey LIMIT 0 10
]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
if
{
$::verbose
}
{
flush stdout
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