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 {
...
@@ -142,9 +142,15 @@ proc ::redis::redis_multi_bulk_read fd {
set count
[
redis_read_line $fd
]
set count
[
redis_read_line $fd
]
if
{
$count
== -1
}
return
{}
if
{
$count
== -1
}
return
{}
set l
{}
set l
{}
set err
{}
for
{
set i 0
}
{
$i
< $count
}
{
incr i
}
{
for
{
set i 0
}
{
$i
< $count
}
{
incr i
}
{
if
{[
catch
{
lappend l
[
redis_read_reply $fd
]
lappend l
[
redis_read_reply $fd
]
}
e
]
&& $err eq
{}}
{
set err $e
}
}
}
if
{
$err
ne
{}}
{
return -code error $err
}
return $l
return $l
}
}
...
@@ -160,7 +166,7 @@ proc ::redis::redis_read_reply fd {
...
@@ -160,7 +166,7 @@ proc ::redis::redis_read_reply fd {
-
{
return -code error
[
redis_read_line $fd
]}
-
{
return -code error
[
redis_read_line $fd
]}
$
{
redis_bulk_read $fd
}
$
{
redis_bulk_read $fd
}
*
{
redis_multi_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 {}
...
@@ -2,13 +2,14 @@ set ::global_overrides {}
set ::tags
{}
set ::tags
{}
set ::valgrind_errors
{}
set ::valgrind_errors
{}
proc error_and_quit
{
config_file error
}
{
proc start_server_error
{
config_file error
}
{
puts
"!!COULD NOT START REDIS-SERVER
\n
"
set err
{}
puts
"CONFIGURATION:"
append err
"Cant' start the Redis server
\n
"
puts
[
exec cat $config_file
]
append err
"CONFIGURATION:"
puts
"
\n
ERROR:"
append err
[
exec cat $config_file
]
puts
[
string trim $error
]
append err
"
\n
ERROR:"
exit 1
append err
[
string trim $error
]
send_data_packet $::test_server_fd err $err
}
}
proc check_valgrind_errors stderr
{
proc check_valgrind_errors stderr
{
...
@@ -16,7 +17,7 @@ proc check_valgrind_errors stderr {
...
@@ -16,7 +17,7 @@ proc check_valgrind_errors stderr {
set buf
[
read $fd
]
set buf
[
read $fd
]
close $fd
close $fd
if
{
!
[
regexp --
{
ERROR SUMMARY: 0 errors
}
$buf
]
||
if
{[
regexp --
{
at 0x
}
$buf
]
||
(
!
[
regexp --
{
definitely lost: 0 bytes
}
$buf
]
&&
(
!
[
regexp --
{
definitely lost: 0 bytes
}
$buf
]
&&
!
[
regexp --
{
no leaks are possible
}
$buf
])}
{
!
[
regexp --
{
no leaks are possible
}
$buf
])}
{
send_data_packet $::test_server_fd err
"Valgrind error:
$buf
\n
"
send_data_packet $::test_server_fd err
"Valgrind error:
$buf
\n
"
...
@@ -45,11 +46,16 @@ proc kill_server config {
...
@@ -45,11 +46,16 @@ proc kill_server config {
}
}
# kill server and wait for the process to be totally exited
# kill server and wait for the process to be totally exited
catch
{
exec kill $pid
}
while
{[
is_alive $config
]}
{
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..."
puts
"Waiting for process
$pid
to exit..."
}
}
catch
{
exec kill $pid
}
after 10
after 10
}
}
...
@@ -175,14 +181,14 @@ proc start_server {options {code undefined}} {
...
@@ -175,14 +181,14 @@ proc start_server {options {code undefined}} {
set stderr
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stderr"
]
set stderr
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stderr"
]
if
{
$::valgrind
}
{
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
{
}
else
{
exec src/redis-server $config_file > $stdout 2> $stderr &
exec src/redis-server $config_file > $stdout 2> $stderr &
}
}
# check that the server actually started
# check that the server actually started
# ugly but tries to be as fast as possible...
# ugly but tries to be as fast as possible...
set retrynum 100
if
{
$::valgrind
}
{
set retrynum 1000
}
else
{
set retrynum 100
}
set serverisup 0
set serverisup 0
if
{
$::verbose
}
{
if
{
$::verbose
}
{
...
@@ -209,7 +215,10 @@ proc start_server {options {code undefined}} {
...
@@ -209,7 +215,10 @@ proc start_server {options {code undefined}} {
}
}
if
{
!$serverisup
}
{
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
# find out the pid
...
@@ -243,7 +252,7 @@ proc start_server {options {code undefined}} {
...
@@ -243,7 +252,7 @@ proc start_server {options {code undefined}} {
while 1
{
while 1
{
# check that the server actually started and is ready for connections
# 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
break
}
}
after 10
after 10
...
...
tests/support/test.tcl
View file @
28500d19
...
@@ -3,6 +3,10 @@ set ::num_passed 0
...
@@ -3,6 +3,10 @@ set ::num_passed 0
set ::num_failed 0
set ::num_failed 0
set ::tests_failed
{}
set ::tests_failed
{}
proc fail
{
msg
}
{
error
"assertion:
$msg
"
}
proc assert
{
condition
}
{
proc assert
{
condition
}
{
if
{
!
[
uplevel 1
[
list expr $condition
]]}
{
if
{
!
[
uplevel 1
[
list expr $condition
]]}
{
error
"assertion:Expected condition '
$condition
' to be true (
[
uplevel 1
[
list subst -nocommands $condition
]]
)"
error
"assertion:Expected condition '
$condition
' to be true (
[
uplevel 1
[
list subst -nocommands $condition
]]
)"
...
@@ -44,6 +48,19 @@ proc assert_type {type key} {
...
@@ -44,6 +48,19 @@ proc assert_type {type key} {
assert_equal $type
[
r 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
# Test if TERM looks like to support colors
proc color_term
{}
{
proc color_term
{}
{
expr
{[
info exists ::env
(
TERM
)]
&&
[
string match *xterm* $::env
(
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 {
...
@@ -294,3 +294,7 @@ proc csvdump r {
proc csvstring s
{
proc csvstring s
{
return
"
\"
$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