Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ruanhaishen
redis
Commits
28500d19
Commit
28500d19
authored
Apr 30, 2012
by
antirez
Browse files
Testing framework fixes and improvements backported from 2.6.
parent
63bae7c5
Changes
4
Show whitespace changes
Inline
Side-by-side
tests/support/redis.tcl
View file @
28500d19
...
...
@@ -142,9 +142,15 @@ proc ::redis::redis_multi_bulk_read fd {
set count
[
redis_read_line $fd
]
if
{
$count
== -1
}
return
{}
set l
{}
set err
{}
for
{
set i 0
}
{
$i
< $count
}
{
incr i
}
{
if
{[
catch
{
lappend l
[
redis_read_reply $fd
]
}
e
]
&& $err eq
{}}
{
set err $e
}
}
if
{
$err
ne
{}}
{
return -code error $err
}
return $l
}
...
...
@@ -160,7 +166,7 @@ proc ::redis::redis_read_reply fd {
-
{
return -code error
[
redis_read_line $fd
]}
$
{
redis_bulk_read $fd
}
*
{
redis_multi_bulk_read $fd
}
default
{
return -code error
"Bad protocol,
$type
as reply type byte"
}
default
{
return -code error
"Bad protocol,
'
$type
'
as reply type byte"
}
}
}
...
...
tests/support/server.tcl
View file @
28500d19
...
...
@@ -2,13 +2,14 @@ set ::global_overrides {}
set ::tags
{}
set ::valgrind_errors
{}
proc error_and_quit
{
config_file error
}
{
puts
"!!COULD NOT START REDIS-SERVER
\n
"
puts
"CONFIGURATION:"
puts
[
exec cat $config_file
]
puts
"
\n
ERROR:"
puts
[
string trim $error
]
exit 1
proc start_server_error
{
config_file error
}
{
set err
{}
append err
"Cant' start the Redis server
\n
"
append err
"CONFIGURATION:"
append err
[
exec cat $config_file
]
append err
"
\n
ERROR:"
append err
[
string trim $error
]
send_data_packet $::test_server_fd err $err
}
proc check_valgrind_errors stderr
{
...
...
@@ -16,7 +17,7 @@ proc check_valgrind_errors stderr {
set buf
[
read $fd
]
close $fd
if
{
!
[
regexp --
{
ERROR SUMMARY: 0 errors
}
$buf
]
||
if
{[
regexp --
{
at 0x
}
$buf
]
||
(
!
[
regexp --
{
definitely lost: 0 bytes
}
$buf
]
&&
!
[
regexp --
{
no leaks are possible
}
$buf
])}
{
send_data_packet $::test_server_fd err
"Valgrind error:
$buf
\n
"
...
...
@@ -45,11 +46,16 @@ proc kill_server config {
}
# kill server and wait for the process to be totally exited
catch
{
exec kill $pid
}
while
{[
is_alive $config
]}
{
if
{[
incr wait 10
]
% 1000 == 0
}
{
incr wait 10
if
{
$wait
>= 5000
}
{
puts
"Forcing process
$pid
to exit..."
catch
{
exec kill -KILL $pid
}
}
elseif
{
$wait
% 1000 == 0
}
{
puts
"Waiting for process
$pid
to exit..."
}
catch
{
exec kill $pid
}
after 10
}
...
...
@@ -175,14 +181,14 @@ proc start_server {options {code undefined}} {
set stderr
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stderr"
]
if
{
$::valgrind
}
{
exec valgrind --suppressions=src/valgrind.sup src/redis-server $config_file > $stdout 2> $stderr &
exec valgrind --suppressions=src/valgrind.sup
--show-reachable=no --show-possibly-lost=no --leak-check=full
src/redis-server $config_file > $stdout 2> $stderr &
}
else
{
exec src/redis-server $config_file > $stdout 2> $stderr &
}
# check that the server actually started
# ugly but tries to be as fast as possible...
set retrynum 100
if
{
$::valgrind
}
{
set retrynum 1000
}
else
{
set retrynum 100
}
set serverisup 0
if
{
$::verbose
}
{
...
...
@@ -209,7 +215,10 @@ proc start_server {options {code undefined}} {
}
if
{
!$serverisup
}
{
error_and_quit $config_file
[
exec cat $stderr
]
set err
{}
append err
[
exec cat $stdout
]
"
\n
"
[
exec cat $stderr
]
start_server_error $config_file $err
return
}
# find out the pid
...
...
@@ -243,7 +252,7 @@ proc start_server {options {code undefined}} {
while 1
{
# check that the server actually started and is ready for connections
if
{[
exec
cat $stdout |
grep
"ready to accept"
| wc -l
]
> 0
}
{
if
{[
exec grep
"ready to accept"
| wc -l
< $stdout
]
> 0
}
{
break
}
after 10
...
...
tests/support/test.tcl
View file @
28500d19
...
...
@@ -3,6 +3,10 @@ set ::num_passed 0
set ::num_failed 0
set ::tests_failed
{}
proc fail
{
msg
}
{
error
"assertion:
$msg
"
}
proc assert
{
condition
}
{
if
{
!
[
uplevel 1
[
list expr $condition
]]}
{
error
"assertion:Expected condition '
$condition
' to be true (
[
uplevel 1
[
list subst -nocommands $condition
]]
)"
...
...
@@ -44,6 +48,19 @@ proc assert_type {type key} {
assert_equal $type
[
r type $key
]
}
# Wait for the specified condition to be true, with the specified number of
# max retries and delay between retries. Otherwise the 'elsescript' is
# executed.
proc wait_for_condition
{
maxtries delay e _else_ elsescript
}
{
while
{[
incr maxtries -1
]
>= 0
}
{
if
{[
uplevel 1
[
list expr $e
]]}
break
after $delay
}
if
{
$maxtries
== -1
}
{
uplevel 1 $elsescript
}
}
# Test if TERM looks like to support colors
proc color_term
{}
{
expr
{[
info exists ::env
(
TERM
)]
&&
[
string match *xterm* $::env
(
TERM
)]}
...
...
tests/support/util.tcl
View file @
28500d19
...
...
@@ -294,3 +294,7 @@ proc csvdump r {
proc csvstring s
{
return
"
\"
$s
\"
"
}
proc roundFloat f
{
format
"%.10g"
$f
}
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