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
43c9dc7b
Commit
43c9dc7b
authored
Mar 24, 2009
by
antirez
Browse files
Now the Redis test uses the proper Tcl client library
parent
95869437
Changes
1
Hide whitespace changes
Inline
Side-by-side
test-redis.tcl
View file @
43c9dc7b
# TODO # test pipelining
source client-libraries/tcl/redis.tcl
set ::passed 0
set ::failed 0
...
...
@@ -17,148 +19,145 @@ proc test {name code okpattern} {
}
proc main
{
server port
}
{
set fd
[
redis_connect $server $port
]
set r
[
redis $server $port
]
set err
""
test
{
DEL all keys to start with a clean DB
}
{
foreach key
[
redis_keys $fd *
]
{
redis_del $fd $key
}
redis_dbsize $fd
foreach key
[
$r
keys *
]
{
$r
del $key
}
$r dbsize
}
{
0
}
test
{
SET and GET an item
}
{
redis_set $fd
x foobar
redis_get $fd
x
$r set
x foobar
$r get
x
}
{
foobar
}
test
{
DEL against a single item
}
{
redis_del $fd
x
redis_get $fd
x
$r del
x
$r get
x
}
{}
test
{
KEYS with pattern
}
{
foreach key
{
key_x key_y key_z foo_a foo_b foo_c
}
{
redis_set $fd
$key hello
$r set
$key hello
}
lsort
[
redis_keys $fd
foo*
]
lsort
[
$r
keys
foo*
]
}
{
foo_a foo_b foo_c
}
test
{
KEYS to get all keys
}
{
lsort
[
redis_keys $fd
*
]
lsort
[
$r
keys
*
]
}
{
foo_a foo_b foo_c key_x key_y key_z
}
test
{
DBSIZE
}
{
redis_
dbsize
$fd
$r
dbsize
}
{
6
}
test
{
DEL all keys
}
{
foreach key
[
redis_keys $fd *
]
{
redis_del $fd $key
}
redis_dbsize $fd
foreach key
[
$r
keys *
]
{
$r
del $key
}
$r dbsize
}
{
0
}
test
{
Very big payload in GET/SET
}
{
set buf
[
string repeat
"abcd"
1000000
]
redis_set $fd
foo $buf
redis_get $fd
foo
$r set
foo $buf
$r get
foo
}
[
string repeat
"abcd"
1000000
]
test
{
SET 10000 numeric keys and access all them in reverse order
}
{
for
{
set x 0
}
{
$x
< 10000
}
{
incr x
}
{
redis_set $fd
$x $x
$r set
$x $x
}
set sum 0
for
{
set x 9999
}
{
$x
>= 0
}
{
incr x -1
}
{
incr sum
[
redis_get $fd
$x
]
incr sum
[
$r
get
$x
]
}
format $sum
}
{
49995000
}
test
{
DBSIZE should be 10001 now
}
{
redis_
dbsize
$fd
$r
dbsize
}
{
10001
}
test
{
INCR against non existing key
}
{
set res
{}
append res
[
redis_incr $fd
novar
]
append res
[
redis_get $fd
novar
]
append res
[
$r
incr
novar
]
append res
[
$r
get
novar
]
}
{
11
}
test
{
INCR against key created by incr itself
}
{
redis_incr $fd
novar
$r incr
novar
}
{
2
}
test
{
INCR against key originally set with SET
}
{
redis_set $fd
novar 100
redis_incr $fd
novar
$r set
novar 100
$r incr
novar
}
{
101
}
test
{
SETNX target key missing
}
{
redis_
setnx
$fd
novar2 foobared
redis_get $fd
novar2
$r
setnx novar2 foobared
$r get
novar2
}
{
foobared
}
test
{
SETNX target key exists
}
{
redis_
setnx
$fd
novar2 blabla
redis_get $fd
novar2
$r
setnx novar2 blabla
$r get
novar2
}
{
foobared
}
test
{
EXISTS
}
{
set res
{}
redis_set $fd
newkey test
append res
[
redis_
exists
$fd
newkey
]
redis_del $fd
newkey
append res
[
redis_
exists
$fd
newkey
]
$r set
newkey test
append res
[
$r
exists newkey
]
$r del
newkey
append res
[
$r
exists newkey
]
}
{
10
}
test
{
Zero length value in key. SET/GET/EXISTS
}
{
redis_set $fd
emptykey
{}
set res
[
redis_get $fd
emptykey
]
append res
[
redis_
exists
$fd
emptykey
]
redis_del $fd
emptykey
append res
[
redis_
exists
$fd
emptykey
]
$r set
emptykey
{}
set res
[
$r
get
emptykey
]
append res
[
$r
exists emptykey
]
$r del
emptykey
append res
[
$r
exists emptykey
]
}
{
10
}
test
{
Commands pipelining
}
{
set fd
[
$r
channel
]
puts -nonewline $fd
"SET k1 4
\r\n
xyzk
\r\n
GET k1
\r\n
PING
\r\n
"
flush $fd
set res
{}
append res
[
string match OK*
[
redis_read_reply $fd
]]
append res
[
redis_read_reply $fd
]
append res
[
string match PONG*
[
redis_read_reply $fd
]]
append res
[
string match OK*
[
::redis::
redis_read_reply $fd
]]
append res
[
::redis::
redis_read_reply $fd
]
append res
[
string match PONG*
[
::redis::
redis_read_reply $fd
]]
format $res
}
{
1xyzk1
}
test
{
Non existing command
}
{
puts -nonewline $fd
"foo
\r\n
"
flush $fd
string match ERR*
[
redis_read_reply $fd
]
catch
{
$r
foobaredcommand
}
err
string match ERR* $err
}
{
1
}
test
{
Basic LPUSH, RPUSH, LLENGTH, LINDEX
}
{
redis_
lpush
$fd
mylist a
redis_
lpush
$fd
mylist b
redis_
rpush
$fd
mylist c
set res
[
redis_llen $fd
mylist
]
append res
[
redis_
lindex
$fd
mylist 0
]
append res
[
redis_
lindex
$fd
mylist 1
]
append res
[
redis_
lindex
$fd
mylist 2
]
$r
lpush mylist a
$r
lpush mylist b
$r
rpush mylist c
set res
[
$r
llen
mylist
]
append res
[
$r
lindex mylist 0
]
append res
[
$r
lindex mylist 1
]
append res
[
$r
lindex mylist 2
]
}
{
3bac
}
test
{
DEL a list
}
{
redis_del $fd
mylist
redis_
exists
$fd
mylist
$r del
mylist
$r
exists mylist
}
{
0
}
test
{
Create a long list and check every single element with LINDEX
}
{
set ok 0
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
redis_
rpush
$fd
mylist $i
$r
rpush mylist $i
}
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
if
{[
redis_
lindex
$fd
mylist $i
]
eq $i
}
{
incr ok
}
if
{[
redis_
lindex
$fd
mylist
[
expr
(
-$i
)
-1
]]
eq
[
expr 999-$i
]}
{
if
{[
$r
lindex mylist $i
]
eq $i
}
{
incr ok
}
if
{[
$r
lindex mylist
[
expr
(
-$i
)
-1
]]
eq
[
expr 999-$i
]}
{
incr ok
}
}
...
...
@@ -168,9 +167,9 @@ proc main {server port} {
test
{
Test elements with LINDEX in random access
}
{
set ok 0
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
set r
[
expr int
(
rand
()
*1000
)]
if
{[
redis_
lindex
$fd
mylist $r
]
eq $r
}
{
incr ok
}
if
{[
redis_
lindex
$fd
mylist
[
expr
(
-$r
)
-1
]]
eq
[
expr 999-$r
]}
{
set r
int
[
expr int
(
rand
()
*1000
)]
if
{[
$r
lindex mylist $r
int
]
eq $r
int
}
{
incr ok
}
if
{[
$r
lindex mylist
[
expr
(
-$r
int
)
-1
]]
eq
[
expr 999-$r
int
]}
{
incr ok
}
}
...
...
@@ -178,259 +177,270 @@ proc main {server port} {
}
{
2000
}
test
{
LLEN against non-list value error
}
{
redis_del $fd mylist
redis_set $fd mylist foobar
redis_llen $fd mylist
$r del mylist
$r set mylist foobar
catch
{
$r
llen mylist
}
err
format $err
}
{
ERR*
}
test
{
LINDEX against non-list value error
}
{
redis_lindex $fd mylist 0
catch
{
$r
lindex mylist 0
}
err
format $err
}
{
ERR*
}
test
{
LPUSH against non-list value error
}
{
redis_lpush $fd mylist 0
catch
{
$r
lpush mylist 0
}
err
format $err
}
{
ERR*
}
test
{
RPUSH against non-list value error
}
{
redis_rpush $fd mylist 0
catch
{
$r
rpush mylist 0
}
err
format $err
}
{
ERR*
}
test
{
RENAME basic usage
}
{
redis_set $fd
mykey hello
redis_
rename
$fd
mykey mykey1
redis_
rename
$fd
mykey1 mykey2
redis_get $fd
mykey2
$r set
mykey hello
$r
rename mykey mykey1
$r
rename mykey1 mykey2
$r get
mykey2
}
{
hello
}
test
{
RENAME source key should no longer exist
}
{
redis_
exists
$fd
mykey
$r
exists mykey
}
{
0
}
test
{
RENAME against already existing key
}
{
redis_set $fd
mykey a
redis_set $fd
mykey2 b
redis_
rename
$fd
mykey2 mykey
set res
[
redis_get $fd
mykey
]
append res
[
redis_
exists
$fd
mykey2
]
$r set
mykey a
$r set
mykey2 b
$r
rename mykey2 mykey
set res
[
$r
get
mykey
]
append res
[
$r
exists mykey2
]
}
{
b0
}
test
{
RENAMENX basic usage
}
{
redis_del $fd
mykey
redis_del $fd
mykey2
redis_set $fd
mykey foobar
redis_
renamenx
$fd
mykey mykey2
set res
[
redis_get $fd
mykey2
]
append res
[
redis_
exists
$fd
mykey
]
$r del
mykey
$r del
mykey2
$r set
mykey foobar
$r
renamenx mykey mykey2
set res
[
$r
get
mykey2
]
append res
[
$r
exists mykey
]
}
{
foobar0
}
test
{
RENAMENX against already existing key
}
{
redis_set $fd
mykey foo
redis_set $fd
mykey2 bar
redis_
renamenx
$fd
mykey mykey2
$r set
mykey foo
$r set
mykey2 bar
$r
renamenx mykey mykey2
}
{
0
}
test
{
RENAMENX against already existing key
(
2
)}
{
set res
[
redis_get $fd
mykey
]
append res
[
redis_get $fd
mykey2
]
set res
[
$r
get
mykey
]
append res
[
$r
get
mykey2
]
}
{
foobar
}
test
{
RENAME against non existing source key
}
{
redis_rename $fd nokey foobar
catch
{
$r
rename nokey foobar
}
err
format $err
}
{
ERR*
}
test
{
RENAME where source and dest key is the same
}
{
redis_rename $fd mykey mykey
catch
{
$r
rename mykey mykey
}
err
format $err
}
{
ERR*
}
test
{
DEL all keys again
(
DB 0
)}
{
foreach key
[
redis_keys $fd
*
]
{
redis_del $fd
$key
foreach key
[
$r
keys
*
]
{
$r del
$key
}
redis_
dbsize
$fd
$r
dbsize
}
{
0
}
test
{
DEL all keys again
(
DB 1
)}
{
redis_
select
$fd
1
foreach key
[
redis_keys $fd
*
]
{
redis_del $fd
$key
$r
select 1
foreach key
[
$r
keys
*
]
{
$r del
$key
}
set res
[
redis_
dbsize
$fd
]
redis_
select
$fd
0
set res
[
$r
dbsize
]
$r
select 0
format $res
}
{
0
}
test
{
MOVE basic usage
}
{
redis_set $fd
mykey foobar
redis_move $fd
mykey 1
$r set
mykey foobar
$r move
mykey 1
set res
{}
lappend res
[
redis_
exists
$fd
mykey
]
lappend res
[
redis_
dbsize
$fd
]
redis_
select
$fd
1
lappend res
[
redis_get $fd
mykey
]
lappend res
[
redis_
dbsize
$fd
]
redis_
select
$fd
0
lappend res
[
$r
exists mykey
]
lappend res
[
$r
dbsize
]
$r
select 1
lappend res
[
$r
get
mykey
]
lappend res
[
$r
dbsize
]
$r
select 0
format $res
}
[
list 0 0 foobar 1
]
test
{
MOVE against key existing in the target DB
}
{
redis_set $fd
mykey hello
redis_move $fd
mykey 1
$r set
mykey hello
$r move
mykey 1
}
{
0
}
test
{
SET/GET keys in different DBs
}
{
redis_set $fd
a hello
redis_set $fd
b world
redis_
select
$fd
1
redis_set $fd
a foo
redis_set $fd
b bared
redis_
select
$fd
0
$r set
a hello
$r set
b world
$r
select 1
$r set
a foo
$r set
b bared
$r
select 0
set res
{}
lappend res
[
redis_get $fd
a
]
lappend res
[
redis_get $fd
b
]
redis_
select
$fd
1
lappend res
[
redis_get $fd
a
]
lappend res
[
redis_get $fd
b
]
redis_
select
$fd
0
lappend res
[
$r
get
a
]
lappend res
[
$r
get
b
]
$r
select 1
lappend res
[
$r
get
a
]
lappend res
[
$r
get
b
]
$r
select 0
format $res
}
{
hello world foo bared
}
test
{
Basic LPOP/RPOP
}
{
redis_del $fd
mylist
redis_
rpush
$fd
mylist 1
redis_
rpush
$fd
mylist 2
redis_
lpush
$fd
mylist 0
list
[
redis_lpop $fd mylist
]
[
redis_rpop $fd mylist
]
[
redis_lpop $fd mylist
]
[
redis_llen $fd
mylist
]
$r del
mylist
$r
rpush mylist 1
$r
rpush mylist 2
$r
lpush mylist 0
list
[
$r
lpop mylist
]
[
$r
rpop mylist
]
[
$r
lpop mylist
]
[
$r
llen
mylist
]
}
[
list 0 2 1 0
]
test
{
LPOP/RPOP against empty list
}
{
redis_lpop $fd
mylist
$r lpop
mylist
}
{}
test
{
LPOP against non list value
}
{
redis_set $fd notalist foo
redis_lpop $fd notalist
$r set notalist foo
catch
{
$r
lpop notalist
}
err
format $err
}
{
ERR*kind*
}
test
{
Mass LPUSH/LPOP
}
{
set sum 0
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
redis_
lpush
$fd
mylist $i
$r
lpush mylist $i
incr sum $i
}
set sum2 0
for
{
set i 0
}
{
$i
< 500
}
{
incr i
}
{
incr sum2
[
redis_lpop $fd
mylist
]
incr sum2
[
redis_rpop $fd
mylist
]
incr sum2
[
$r
lpop
mylist
]
incr sum2
[
$r
rpop
mylist
]
}
expr $sum == $sum2
}
{
1
}
test
{
LRANGE basics
}
{
for
{
set i 0
}
{
$i
< 10
}
{
incr i
}
{
redis_
rpush
$fd
mylist $i
$r
rpush mylist $i
}
list
[
redis_
lrange
$fd
mylist 1 -2
]
\
[
redis_
lrange
$fd
mylist -3 -1
]
\
[
redis_
lrange
$fd
mylist 4 4
]
list
[
$r
lrange mylist 1 -2
]
\
[
$r
lrange mylist -3 -1
]
\
[
$r
lrange mylist 4 4
]
}
{{
1 2 3 4 5 6 7 8
}
{
7 8 9
}
4
}
test
{
LRANGE inverted indexes
}
{
redis_
lrange
$fd
mylist 6 2
$r
lrange mylist 6 2
}
{}
test
{
LRANGE out of range indexes including the full list
}
{
redis_
lrange
$fd
mylist -1000 1000
$r
lrange mylist -1000 1000
}
{
0 1 2 3 4 5 6 7 8 9
}
test
{
LRANGE against non existing key
}
{
redis_
lrange
$fd
nosuchkey 0 1
$r
lrange nosuchkey 0 1
}
{}
test
{
LTRIM basics
}
{
redis_del $fd
mylist
$r del
mylist
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
redis_
lpush
$fd
mylist $i
redis_
ltrim
$fd
mylist 0 4
$r
lpush mylist $i
$r
ltrim mylist 0 4
}
redis_
lrange
$fd
mylist 0 -1
$r
lrange mylist 0 -1
}
{
99 98 97 96 95
}
test
{
LSET
}
{
redis_lset $fd
mylist 1 foo
redis_lset $fd
mylist -1 bar
redis_
lrange
$fd
mylist 0 -1
$r lset
mylist 1 foo
$r lset
mylist -1 bar
$r
lrange mylist 0 -1
}
{
99 foo 97 96 bar
}
test
{
LSET out of range index
}
{
redis_lset $fd mylist 10 foo
catch
{
$r
lset mylist 10 foo
}
err
format $err
}
{
ERR*range*
}
test
{
LSET against non existing key
}
{
redis_lset $fd nosuchkey 10 foo
catch
{
$r
lset nosuchkey 10 foo
}
err
format $err
}
{
ERR*key*
}
test
{
LSET against non list value
}
{
redis_set $fd nolist foobar
redis_lset $fd nolist 0 foo
$r set nolist foobar
catch
{
$r
lset nolist 0 foo
}
err
format $err
}
{
ERR*value*
}
test
{
SADD, SCARD, SISMEMBER, SMEMBERS basics
}
{
redis_sadd $f
d myset foo
redis_sadd $f
d myset bar
list
[
redis_scard $f
d myset
]
[
redis_
sismember
$fd
myset foo
]
\
[
redis_
sismember
$fd
myset bar
]
[
redis_
sismember
$fd
myset bla
]
\
[
lsort
[
redis_
smembers
$fd
myset
]]
$r sad
d myset foo
$r sad
d myset bar
list
[
$r
scar
d myset
]
[
$r
sismember myset foo
]
\
[
$r
sismember myset bar
]
[
$r
sismember myset bla
]
\
[
lsort
[
$r
smembers myset
]]
}
{
2 1 1 0
{
bar foo
}}
test
{
SADD adding the same element multiple times
}
{
redis_sadd $f
d myset foo
redis_sadd $f
d myset foo
redis_sadd $f
d myset foo
redis_scard $f
d myset
$r sad
d myset foo
$r sad
d myset foo
$r sad
d myset foo
$r scar
d myset
}
{
2
}
test
{
SADD against non set
}
{
redis_sadd $fd mylist foo
catch
{
$r
sadd mylist foo
}
err
format $err
}
{
ERR*kind*
}
test
{
SREM basics
}
{
redis_sadd $f
d myset ciao
redis_srem $fd
myset foo
lsort
[
redis_
smembers
$fd
myset
]
$r sad
d myset ciao
$r srem
myset foo
lsort
[
$r
smembers myset
]
}
{
bar ciao
}
test
{
Mass SADD and SINTER with two sets
}
{
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
redis_sadd $f
d set1 $i
redis_sadd $f
d set2
[
expr $i+995
]
$r sad
d set1 $i
$r sad
d set2
[
expr $i+995
]
}
lsort
[
redis_
sinter
$fd
set1 set2
]
lsort
[
$r
sinter set1 set2
]
}
{
995 996 997 998 999
}
test
{
SINTERSTORE with two sets
}
{
redis_
sinterstore
$fd
setres set1 set2
lsort
[
redis_
smembers
$fd
setres
]
$r
sinterstore setres set1 set2
lsort
[
$r
smembers setres
]
}
{
995 996 997 998 999
}
test
{
SINTER against three sets
}
{
redis_sadd $f
d set3 999
redis_sadd $f
d set3 995
redis_sadd $f
d set3 1000
redis_sadd $f
d set3 2000
lsort
[
redis_
sinter
$fd
set1 set2 set3
]
$r sad
d set3 999
$r sad
d set3 995
$r sad
d set3 1000
$r sad
d set3 2000
lsort
[
$r
sinter set1 set2 set3
]
}
{
995 999
}
test
{
SINTERSTORE with three sets
}
{
redis_
sinterstore
$fd
setres set1 set2 set3
lsort
[
redis_
smembers
$fd
setres
]
$r
sinterstore setres set1 set2 set3
lsort
[
$r
smembers setres
]
}
{
995 999
}
test
{
SAVE - make sure there are all the types as values
}
{
redis_
lpush
$fd
mysavelist hello
redis_
lpush
$fd
mysavelist world
redis_set $fd
myemptykey
{}
redis_set $fd
mynormalkey
{
blablablba
}
redis_save $fd
$r
lpush mysavelist hello
$r
lpush mysavelist world
$r set
myemptykey
{}
$r set
mynormalkey
{
blablablba
}
$r save
}
{
OK
}
test
{
Create a random list
}
{
...
...
@@ -440,13 +450,13 @@ proc main {server port} {
while 1
{
# Make sure all the weights are different because
# Redis does not use a stable sort but Tcl does.
set r
[
expr int
(
rand
()
*1000000
)]
if
{
!
[
info exists seenrand
(
$r
)]}
break
set r
int
[
expr int
(
rand
()
*1000000
)]
if
{
!
[
info exists seenrand
(
$r
int
)]}
break
}
set seenrand
(
$r
)
x
redis_
lpush
$fd
tosort $i
redis_set $fd
weight_$i $r
lappend tosort
[
list $i $r
]
set seenrand
(
$r
int
)
x
$r
lpush tosort $i
$r set
weight_$i $r
int
lappend tosort
[
list $i $r
int
]
}
set sorted
[
lsort -index 1 -real $tosort
]
set res
{}
...
...
@@ -457,21 +467,21 @@ proc main {server port} {
}
{}
test
{
SORT with BY against the newly created list
}
{
redis_sort $fd
tosort
{
BY weight_*
}
$r sort
tosort
{
BY weight_*
}
}
$res
test
{
SORT direct, numeric, against the newly created list
}
{
redis_sort $fd
tosort
$r sort
tosort
}
[
lsort -integer $res
]
test
{
SORT decreasing sort
}
{
redis_sort $fd
tosort
{
DESC
}
$r sort
tosort
{
DESC
}
}
[
lsort -decreasing -integer $res
]
test
{
SORT speed, sorting 10000 elements list using BY, 100 times
}
{
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set sorted
[
redis_sort $fd
tosort
{
BY weight_* LIMIT 0 10
}]
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 "
...
...
@@ -482,7 +492,7 @@ proc main {server port} {
test
{
SORT speed, sorting 10000 elements list directly, 100 times
}
{
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set sorted
[
redis_sort $fd
tosort
{
LIMIT 0 10
}]
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 "
...
...
@@ -493,7 +503,7 @@ proc main {server port} {
test
{
SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times
}
{
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set sorted
[
redis_sort $fd
tosort
{
BY nokey LIMIT 0 10
}]
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 "
...
...
@@ -502,78 +512,78 @@ proc main {server port} {
}
{}
test
{
SORT regression for issue #19, sorting floats
}
{
redis_
flushdb
$fd
$r
flushdb
foreach x
{
1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15
}
{
redis_
lpush
$fd
mylist $x
$r
lpush mylist $x
}
redis_sort $fd
mylist
$r sort
mylist
}
[
lsort -real
{
1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15
}]
test
{
LREM, remove all the occurrences
}
{
redis_
flushall
$fd
redis_
rpush
$fd
mylist foo
redis_
rpush
$fd
mylist bar
redis_
rpush
$fd
mylist foobar
redis_
rpush
$fd
mylist foobared
redis_
rpush
$fd
mylist zap
redis_
rpush
$fd
mylist bar
redis_
rpush
$fd
mylist test
redis_
rpush
$fd
mylist foo
set res
[
redis_lrem $fd
mylist 0 bar
]
list
[
redis_
lrange
$fd
mylist 0 -1
]
$res
$r
flushall
$r
rpush mylist foo
$r
rpush mylist bar
$r
rpush mylist foobar
$r
rpush mylist foobared
$r
rpush mylist zap
$r
rpush mylist bar
$r
rpush mylist test
$r
rpush mylist foo
set res
[
$r
lrem
mylist 0 bar
]
list
[
$r
lrange mylist 0 -1
]
$res
}
{{
foo foobar foobared zap test foo
}
2
}
test
{
LREM, remove the first occurrence
}
{
set res
[
redis_lrem $fd
mylist 1 foo
]
list
[
redis_
lrange
$fd
mylist 0 -1
]
$res
set res
[
$r
lrem
mylist 1 foo
]
list
[
$r
lrange mylist 0 -1
]
$res
}
{{
foobar foobared zap test foo
}
1
}
test
{
LREM, remove non existing element
}
{
set res
[
redis_lrem $fd
mylist 1 nosuchelement
]
list
[
redis_
lrange
$fd
mylist 0 -1
]
$res
set res
[
$r
lrem
mylist 1 nosuchelement
]
list
[
$r
lrange mylist 0 -1
]
$res
}
{{
foobar foobared zap test foo
}
0
}
test
{
LREM, starting from tail with negative count
}
{
redis_
flushall
$fd
redis_
rpush
$fd
mylist foo
redis_
rpush
$fd
mylist bar
redis_
rpush
$fd
mylist foobar
redis_
rpush
$fd
mylist foobared
redis_
rpush
$fd
mylist zap
redis_
rpush
$fd
mylist bar
redis_
rpush
$fd
mylist test
redis_
rpush
$fd
mylist foo
redis_
rpush
$fd
mylist foo
set res
[
redis_lrem $fd
mylist -1 bar
]
list
[
redis_
lrange
$fd
mylist 0 -1
]
$res
$r
flushall
$r
rpush mylist foo
$r
rpush mylist bar
$r
rpush mylist foobar
$r
rpush mylist foobared
$r
rpush mylist zap
$r
rpush mylist bar
$r
rpush mylist test
$r
rpush mylist foo
$r
rpush mylist foo
set res
[
$r
lrem
mylist -1 bar
]
list
[
$r
lrange mylist 0 -1
]
$res
}
{{
foo bar foobar foobared zap test foo foo
}
1
}
test
{
LREM, starting from tail with negative count
(
2
)}
{
set res
[
redis_lrem $fd
mylist -2 foo
]
list
[
redis_
lrange
$fd
mylist 0 -1
]
$res
set res
[
$r
lrem
mylist -2 foo
]
list
[
$r
lrange mylist 0 -1
]
$res
}
{{
foo bar foobar foobared zap test
}
2
}
test
{
MGET
}
{
redis_
flushall
$fd
redis_set $fd
foo BAR
redis_set $fd
bar FOO
redis_mget $fd
foo bar
$r
flushall
$r set
foo BAR
$r set
bar FOO
$r mget
foo bar
}
{
BAR FOO
}
test
{
MGET against non existing key
}
{
redis_mget $fd
foo baazz bar
$r mget
foo baazz bar
}
{
BAR
{}
FOO
}
test
{
MGET against non-string key
}
{
redis_sadd $f
d myset ciao
redis_sadd $f
d myset bau
redis_mget $fd
foo baazz bar myset
$r sad
d myset ciao
$r sad
d myset bau
$r mget
foo baazz bar myset
}
{
BAR
{}
FOO
{}}
# Leave the user with a clean DB before to exit
test
{
FLUSHALL
}
{
redis_
flushall
$fd
redis_
dbsize
$fd
$r
flushall
$r
dbsize
}
{
0
}
puts
"
\n
[
expr $::passed+$::failed
]
tests,
$::passed
passed,
$::failed
failed"
...
...
@@ -583,272 +593,30 @@ proc main {server port} {
close $fd
}
proc redis_connect
{
server port
}
{
set fd
[
socket $server $port
]
fconfigure $fd -translation binary
return $fd
}
proc redis_write
{
fd buf
}
{
puts -nonewline $fd $buf
}
proc redis_writenl
{
fd buf
}
{
# puts
"C:
$buf
"
redis_write $fd $buf
redis_write $fd
"
\r\n
"
flush $fd
}
proc redis_readnl
{
fd len
}
{
set buf
[
read $fd $len
]
read $fd 2
;
# discard CR LF
return $buf
}
proc redis_bulk_read
{
fd
}
{
set count
[
redis_read_line $fd
]
if
{
$count
== -1
}
return
{}
set buf
[
redis_readnl $fd $count
]
return $buf
}
proc redis_multi_bulk_read fd
{
set count
[
redis_read_line $fd
]
if
{
$count
== -1
}
return
{}
set l
{}
for
{
set i 0
}
{
$i
< $count
}
{
incr i
}
{
lappend l
[
redis_read_reply $fd
]
}
return $l
}
proc redis_read_line fd
{
string trim
[
gets $fd
]
}
proc redis_read_reply fd
{
set type
[
read $fd 1
]
if
{
$type
eq
{
:
}}
{
redis_read_line $fd
}
elseif
{
$type
eq
{
-
}}
{
redis_read_line $fd
}
elseif
{
$type
eq
{
+
}}
{
redis_read_line $fd
}
elseif
{
$type
eq
{
$
}}
{
redis_bulk_read $fd
}
elseif
{
$type
eq
{*}
}
{
redis_multi_bulk_read $fd
}
else
{
error
"Bad protocol:
$type
as initial reply byte"
}
}
### Actual API ###
proc redis_set
{
fd key val
}
{
redis_writenl $fd
"set
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_setnx
{
fd key val
}
{
redis_writenl $fd
"setnx
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_get
{
fd key
}
{
redis_writenl $fd
"get
$key
"
redis_read_reply $fd
}
proc redis_select
{
fd id
}
{
redis_writenl $fd
"select
$id
"
redis_read_reply $fd
}
proc redis_move
{
fd key id
}
{
redis_writenl $fd
"move
$key
$id
"
redis_read_reply $fd
}
proc redis_del
{
fd key
}
{
redis_writenl $fd
"del
$key
"
redis_read_reply $fd
}
proc redis_keys
{
fd pattern
}
{
redis_writenl $fd
"keys
$pattern
"
split
[
redis_read_reply $fd
]
}
proc redis_dbsize
{
fd
}
{
redis_writenl $fd
"dbsize"
redis_read_reply $fd
}
proc redis_incr
{
fd key
}
{
redis_writenl $fd
"incr
$key
"
redis_read_reply $fd
}
proc redis_decr
{
fd key
}
{
redis_writenl $fd
"decr
$key
"
redis_read_reply $fd
}
proc redis_exists
{
fd key
}
{
redis_writenl $fd
"exists
$key
"
redis_read_reply $fd
}
proc redis_lpush
{
fd key val
}
{
redis_writenl $fd
"lpush
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_rpush
{
fd key val
}
{
redis_writenl $fd
"rpush
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_llen
{
fd key
}
{
redis_writenl $fd
"llen
$key
"
redis_read_reply $fd
}
proc redis_scard
{
fd key
}
{
redis_writenl $fd
"scard
$key
"
redis_read_reply $fd
}
proc redis_lindex
{
fd key index
}
{
redis_writenl $fd
"lindex
$key
$index
"
redis_read_reply $fd
}
proc redis_lrange
{
fd key first last
}
{
redis_writenl $fd
"lrange
$key
$first
$last
"
redis_read_reply $fd
}
proc redis_mget
{
fd args
}
{
redis_writenl $fd
"mget
[
join $args
]
"
redis_read_reply $fd
}
proc redis_sort
{
fd key
{
params
{}}}
{
redis_writenl $fd
"sort
$key
$params
"
redis_read_reply $fd
}
proc redis_ltrim
{
fd key first last
}
{
redis_writenl $fd
"ltrim
$key
$first
$last
"
redis_read_reply $fd
}
proc redis_rename
{
fd key1 key2
}
{
redis_writenl $fd
"rename
$key1
$key2
"
redis_read_reply $fd
}
proc redis_renamenx
{
fd key1 key2
}
{
redis_writenl $fd
"renamenx
$key1
$key2
"
redis_read_reply $fd
}
proc redis_lpop
{
fd key
}
{
redis_writenl $fd
"lpop
$key
"
redis_read_reply $fd
}
proc redis_rpop
{
fd key
}
{
redis_writenl $fd
"rpop
$key
"
redis_read_reply $fd
}
proc redis_lset
{
fd key index val
}
{
redis_writenl $fd
"lset
$key
$index
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_sadd
{
fd key val
}
{
redis_writenl $fd
"sadd
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_srem
{
fd key val
}
{
redis_writenl $fd
"srem
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_sismember
{
fd key val
}
{
redis_writenl $fd
"sismember
$key
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc redis_sinter
{
fd args
}
{
redis_writenl $fd
"sinter
[
join $args
]
"
redis_read_reply $fd
}
proc redis_sinterstore
{
fd args
}
{
redis_writenl $fd
"sinterstore
[
join $args
]
"
redis_read_reply $fd
}
proc redis_smembers
{
fd key
}
{
redis_writenl $fd
"smembers
$key
"
redis_read_reply $fd
}
proc redis_echo
{
fd str
}
{
redis_writenl $fd
"echo
[
string length $str
]
\r\n
$str
"
redis_read_reply $fd
}
proc redis_save
{
fd
}
{
redis_writenl $fd
"save"
redis_read_reply $fd
}
proc redis_flushall
{
fd
}
{
redis_writenl $fd
"flushall"
redis_read_reply $fd
}
proc redis_flushdb
{
fd
}
{
redis_writenl $fd
"flushdb"
redis_read_reply $fd
}
proc redis_lrem
{
fd key count val
}
{
redis_writenl $fd
"lrem
$key
$count
[
string length $val
]
\r\n
$val
"
redis_read_reply $fd
}
proc stress
{}
{
set fd
[
socket 127.0.0.1 6379
]
fconfigure $fd -translation binary
redis_flushall $fd
set r
[
redis
]
$r flushall
while 1
{
set randkey
[
expr int
(
rand
()
*10000
)]
set randval
[
expr int
(
rand
()
*10000
)]
set randidx0
[
expr int
(
rand
()
*10
)]
set randidx1
[
expr int
(
rand
()
*10
)]
set cmd
[
expr int
(
rand
()
*10
)]
if
{
$cmd
== 0
}
{
redis_set $fd $randkey $randval
}
if
{
$cmd
== 1
}
{
redis_get $fd $randkey
}
if
{
$cmd
== 2
}
{
redis_incr $fd $randkey
}
if
{
$cmd
== 3
}
{
redis_lpush $fd $randkey $randval
}
if
{
$cmd
== 4
}
{
redis_rpop $fd $randkey
}
if
{
$cmd
== 5
}
{
redis_del $fd $randkey
}
if
{
$cmd
== 6
}
{
redis_lrange $fd $randkey $randidx0 $randidx1
}
if
{
$cmd
== 7
}
{
redis_ltrim $fd $randkey $randidx0 $randidx1
}
if
{
$cmd
== 8
}
{
redis_lindex $fd $randkey $randidx0
}
if
{
$cmd
== 9
}
{
redis_lset $fd $randkey $randidx0 $randval
}
catch
{
if
{
$cmd
== 0
}
{
$r
set $randkey $randval
}
if
{
$cmd
== 1
}
{
$r
get $randkey
}
if
{
$cmd
== 2
}
{
$r
incr $randkey
}
if
{
$cmd
== 3
}
{
$r
lpush $randkey $randval
}
if
{
$cmd
== 4
}
{
$r
rpop $randkey
}
if
{
$cmd
== 5
}
{
$r
del $randkey
}
if
{
$cmd
== 6
}
{
$r
lrange $randkey $randidx0 $randidx1
}
if
{
$cmd
== 7
}
{
$r
ltrim $randkey $randidx0 $randidx1
}
if
{
$cmd
== 8
}
{
$r
lindex $randkey $randidx0
}
if
{
$cmd
== 9
}
{
$r
lset $randkey $randidx0 $randval
}
}
flush stdout
}
close
$fd
$r
close
}
if
{[
llength $argv
]
== 0
}
{
...
...
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