From 43c9dc7bd273f39522119415318ec750e678748a Mon Sep 17 00:00:00 2001 From: antirez Date: Tue, 24 Mar 2009 20:00:15 +0100 Subject: [PATCH] Now the Redis test uses the proper Tcl client library --- test-redis.tcl | 748 +++++++++++++++++-------------------------------- 1 file changed, 258 insertions(+), 490 deletions(-) diff --git a/test-redis.tcl b/test-redis.tcl index bc39f85db..9c28ad645 100644 --- a/test-redis.tcl +++ b/test-redis.tcl @@ -1,5 +1,7 @@ # 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\nxyzk\r\nGET k1\r\nPING\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 rint [expr int(rand()*1000)] + if {[$r lindex mylist $rint] eq $rint} {incr ok} + if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} { 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 $fd myset foo - redis_sadd $fd myset bar - list [redis_scard $fd myset] [redis_sismember $fd myset foo] \ - [redis_sismember $fd myset bar] [redis_sismember $fd myset bla] \ - [lsort [redis_smembers $fd myset]] + $r sadd myset foo + $r sadd myset bar + list [$r scard 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 $fd myset foo - redis_sadd $fd myset foo - redis_sadd $fd myset foo - redis_scard $fd myset + $r sadd myset foo + $r sadd myset foo + $r sadd myset foo + $r scard 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 $fd myset ciao - redis_srem $fd myset foo - lsort [redis_smembers $fd myset] + $r sadd 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 $fd set1 $i - redis_sadd $fd set2 [expr $i+995] + $r sadd set1 $i + $r sadd 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 $fd set3 999 - redis_sadd $fd set3 995 - redis_sadd $fd set3 1000 - redis_sadd $fd set3 2000 - lsort [redis_sinter $fd set1 set2 set3] + $r sadd set3 999 + $r sadd set3 995 + $r sadd set3 1000 + $r sadd 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 rint [expr int(rand()*1000000)] + if {![info exists seenrand($rint)]} break } - set seenrand($r) x - redis_lpush $fd tosort $i - redis_set $fd weight_$i $r - lappend tosort [list $i $r] + set seenrand($rint) x + $r lpush tosort $i + $r set weight_$i $rint + lappend tosort [list $i $rint] } 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 , 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 $fd myset ciao - redis_sadd $fd myset bau - redis_mget $fd foo baazz bar myset + $r sadd myset ciao + $r sadd 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} {