]> git.saurik.com Git - redis.git/blame - test-redis.tcl
initial zipmap.c implementation
[redis.git] / test-redis.tcl
CommitLineData
7a932b74 1# test-redis.tcl
2# Redis test suite. Copyright (C) 2009 Salvatore Sanfilippo antirez@gmail.com
3# This softare is released under the BSD License. See the COPYING file for
4# more information.
ed9b544e 5
405b0a6a 6set tcl_precision 17
f89c3a35 7source redis.tcl
43c9dc7b 8
ed9b544e 9set ::passed 0
10set ::failed 0
fc77604c 11set ::testnum 0
ed9b544e 12
13proc test {name code okpattern} {
fc77604c 14 incr ::testnum
15 if {$::testnum < $::first || $::testnum > $::last} return
16 puts -nonewline [format "%-70s " "#$::testnum $name"]
ed9b544e 17 flush stdout
18 set retval [uplevel 1 $code]
19 if {$okpattern eq $retval || [string match $okpattern $retval]} {
20 puts "PASSED"
21 incr ::passed
22 } else {
23 puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'"
24 incr ::failed
25 }
26}
27
75398fbc 28proc randstring {min max {type binary}} {
29 set len [expr {$min+int(rand()*($max-$min+1))}]
30 set output {}
31 if {$type eq {binary}} {
32 set minval 0
33 set maxval 255
34 } elseif {$type eq {alpha}} {
35 set minval 48
36 set maxval 122
37 } elseif {$type eq {compr}} {
38 set minval 48
39 set maxval 52
40 }
41 while {$len} {
42 append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]]
43 incr len -1
44 }
45 return $output
46}
47
d7f43c08 48# Useful for some test
49proc zlistAlikeSort {a b} {
50 if {[lindex $a 0] > [lindex $b 0]} {return 1}
51 if {[lindex $a 0] < [lindex $b 0]} {return -1}
52 string compare [lindex $a 1] [lindex $b 1]
53}
54
0d36ded0 55proc waitForBgsave r {
56 while 1 {
57 set i [$r info]
58 if {[string match {*bgsave_in_progress:1*} $i]} {
59 puts -nonewline "\nWaiting for background save to finish... "
60 flush stdout
61 after 1000
62 } else {
63 break
64 }
65 }
66}
67
e96e4fbf 68proc waitForBgrewriteaof r {
69 while 1 {
70 set i [$r info]
71 if {[string match {*bgrewriteaof_in_progress:1*} $i]} {
72 puts -nonewline "\nWaiting for background AOF rewrite to finish... "
73 flush stdout
74 after 1000
75 } else {
76 break
77 }
78 }
79}
80
e054afda 81proc randomInt {max} {
82 expr {int(rand()*$max)}
83}
84
85proc randpath args {
86 set path [expr {int(rand()*[llength $args])}]
87 uplevel 1 [lindex $args $path]
88}
89
90proc randomValue {} {
91 randpath {
92 # Small enough to likely collide
93 randomInt 1000
94 } {
95 # 32 bit compressible signed/unsigned
96 randpath {randomInt 2000000000} {randomInt 4000000000}
97 } {
98 # 64 bit
99 randpath {randomInt 1000000000000}
100 } {
101 # Random string
102 randpath {randstring 0 256 alpha} \
103 {randstring 0 256 compr} \
104 {randstring 0 256 binary}
105 }
106}
107
108proc randomKey {} {
109 randpath {
110 # Small enough to likely collide
111 randomInt 1000
112 } {
113 # 32 bit compressible signed/unsigned
114 randpath {randomInt 2000000000} {randomInt 4000000000}
115 } {
116 # 64 bit
117 randpath {randomInt 1000000000000}
118 } {
119 # Random string
120 randpath {randstring 1 256 alpha} \
121 {randstring 1 256 compr}
122 }
123}
124
125proc createComplexDataset {r ops} {
126 for {set j 0} {$j < $ops} {incr j} {
127 set k [randomKey]
128 set v [randomValue]
ab9d4cb1 129 randpath {
130 set d [expr {rand()}]
131 } {
132 set d [expr {rand()}]
133 } {
134 set d [expr {rand()}]
135 } {
136 set d [expr {rand()}]
137 } {
138 set d [expr {rand()}]
139 } {
140 randpath {set d +inf} {set d -inf}
141 }
e054afda 142 set t [$r type $k]
143
144 if {$t eq {none}} {
145 randpath {
146 $r set $k $v
147 } {
148 $r lpush $k $v
149 } {
150 $r sadd $k $v
151 } {
152 $r zadd $k $d $v
153 }
154 set t [$r type $k]
155 }
156
157 switch $t {
158 {string} {
159 # Nothing to do
160 }
161 {list} {
162 randpath {$r lpush $k $v} \
163 {$r rpush $k $v} \
164 {$r lrem $k 0 $v} \
165 {$r rpop $k} \
166 {$r lpop $k}
167 }
168 {set} {
169 randpath {$r sadd $k $v} \
170 {$r srem $k $v}
171 }
172 {zset} {
173 randpath {$r zadd $k $d $v} \
174 {$r zrem $k $v}
175 }
176 }
177 }
178}
179
180proc datasetDigest r {
181 set keys [lsort [split [$r keys *] " "]]
e96e4fbf 182 set digest {}
e054afda 183 foreach k $keys {
184 set t [$r type $k]
e96e4fbf 185 switch $t {
186 {string} {
187 set aux [::sha1::sha1 -hex [$r get $k]]
188 } {list} {
189 if {[$r llen $k] == 0} {
190 set aux {}
191 } else {
192 set aux [::sha1::sha1 -hex [$r lrange $k 0 -1]]
193 }
194 } {set} {
195 if {[$r scard $k] == 0} {
196 set aux {}
197 } else {
198 set aux [::sha1::sha1 -hex [lsort [$r smembers $k]]]
199 }
200 } {zset} {
201 if {[$r zcard $k] == 0} {
202 set aux {}
203 } else {
204 set aux [::sha1::sha1 -hex [$r zrange $k 0 -1]]
205 }
206 } default {
207 error "Type not supported"
208 }
e054afda 209 }
e96e4fbf 210 if {$aux eq {}} continue
211 set digest [::sha1::sha1 -hex [join [list $aux $digest $k] "\n"]]
e054afda 212 }
213 return $digest
214}
215
ed9b544e 216proc main {server port} {
43c9dc7b 217 set r [redis $server $port]
eea4baf7 218 $r select 9
43c9dc7b 219 set err ""
fc77604c 220 set res ""
ed9b544e 221
abcb223e
BH
222 # The following AUTH test should be enabled only when requirepass
223 # <PASSWORD> is set in redis.conf and redis-server was started with
224 # redis.conf as the first argument.
225
226 #test {AUTH with requirepass in redis.conf} {
227 # $r auth foobared
228 #} {OK}
229
ed9b544e 230 test {DEL all keys to start with a clean DB} {
43c9dc7b 231 foreach key [$r keys *] {$r del $key}
232 $r dbsize
ed9b544e 233 } {0}
234
235 test {SET and GET an item} {
43c9dc7b 236 $r set x foobar
237 $r get x
ed9b544e 238 } {foobar}
239
7c49733c 240 test {SET and GET an empty item} {
241 $r set x {}
242 $r get x
243 } {}
244
ed9b544e 245 test {DEL against a single item} {
43c9dc7b 246 $r del x
247 $r get x
ed9b544e 248 } {}
249
cc582a77 250 test {Vararg DEL} {
251 $r set foo1 a
252 $r set foo2 b
253 $r set foo3 c
254 list [$r del foo1 foo2 foo3 foo4] [$r mget foo1 foo2 foo3]
255 } {3 {{} {} {}}}
256
ed9b544e 257 test {KEYS with pattern} {
258 foreach key {key_x key_y key_z foo_a foo_b foo_c} {
43c9dc7b 259 $r set $key hello
ed9b544e 260 }
43c9dc7b 261 lsort [$r keys foo*]
ed9b544e 262 } {foo_a foo_b foo_c}
263
264 test {KEYS to get all keys} {
43c9dc7b 265 lsort [$r keys *]
ed9b544e 266 } {foo_a foo_b foo_c key_x key_y key_z}
267
268 test {DBSIZE} {
43c9dc7b 269 $r dbsize
ed9b544e 270 } {6}
271
272 test {DEL all keys} {
43c9dc7b 273 foreach key [$r keys *] {$r del $key}
274 $r dbsize
ed9b544e 275 } {0}
276
277 test {Very big payload in GET/SET} {
278 set buf [string repeat "abcd" 1000000]
43c9dc7b 279 $r set foo $buf
280 $r get foo
ed9b544e 281 } [string repeat "abcd" 1000000]
282
72766462 283 test {Very big payload random access} {
284 set err {}
285 array set payload {}
286 for {set j 0} {$j < 100} {incr j} {
287 set size [expr 1+[randomInt 100000]]
054e426d 288 set buf [string repeat "pl-$j" $size]
72766462 289 set payload($j) $buf
290 $r set bigpayload_$j $buf
291 }
292 for {set j 0} {$j < 1000} {incr j} {
293 set index [randomInt 100]
294 set buf [$r get bigpayload_$index]
295 if {$buf != $payload($index)} {
5f8e5d7c 296 set err "Values differ: I set '$payload($index)' but I read back '$buf'"
72766462 297 break
298 }
299 }
300 unset payload
301 set _ $err
302 } {}
303
ed9b544e 304 test {SET 10000 numeric keys and access all them in reverse order} {
25fd2cb2 305 set err {}
ed9b544e 306 for {set x 0} {$x < 10000} {incr x} {
43c9dc7b 307 $r set $x $x
ed9b544e 308 }
309 set sum 0
310 for {set x 9999} {$x >= 0} {incr x -1} {
25fd2cb2 311 set val [$r get $x]
312 if {$val ne $x} {
313 set err "Eleemnt at position $x is $val instead of $x"
314 break
315 }
ed9b544e 316 }
25fd2cb2 317 set _ $err
d663729a 318 } {}
ed9b544e 319
fefed597 320 test {DBSIZE should be 10101 now} {
43c9dc7b 321 $r dbsize
fefed597 322 } {10101}
ed9b544e 323
324 test {INCR against non existing key} {
325 set res {}
43c9dc7b 326 append res [$r incr novar]
327 append res [$r get novar]
ed9b544e 328 } {11}
329
330 test {INCR against key created by incr itself} {
43c9dc7b 331 $r incr novar
ed9b544e 332 } {2}
333
334 test {INCR against key originally set with SET} {
43c9dc7b 335 $r set novar 100
336 $r incr novar
ed9b544e 337 } {101}
338
d68ed120 339 test {INCR over 32bit value} {
340 $r set novar 17179869184
341 $r incr novar
342 } {17179869185}
343
344 test {INCRBY over 32bit value with over 32bit increment} {
345 $r set novar 17179869184
346 $r incrby novar 17179869184
347 } {34359738368}
348
ab9d4cb1 349 test {INCR against key with spaces (no integer encoded)} {
350 $r set novar " 11 "
351 $r incr novar
352 } {12}
353
d68ed120 354 test {DECRBY over 32bit value with over 32bit increment, negative res} {
355 $r set novar 17179869184
356 $r decrby novar 17179869185
357 } {-1}
358
ed9b544e 359 test {SETNX target key missing} {
43c9dc7b 360 $r setnx novar2 foobared
361 $r get novar2
ed9b544e 362 } {foobared}
363
364 test {SETNX target key exists} {
43c9dc7b 365 $r setnx novar2 blabla
366 $r get novar2
ed9b544e 367 } {foobared}
368
5acdc75d 369 test {SETNX will overwrite EXPIREing key} {
370 $r set x 10
371 $r expire x 10000
372 $r setnx x 20
373 $r get x
374 } {20}
375
ed9b544e 376 test {EXISTS} {
377 set res {}
43c9dc7b 378 $r set newkey test
379 append res [$r exists newkey]
380 $r del newkey
381 append res [$r exists newkey]
ed9b544e 382 } {10}
383
384 test {Zero length value in key. SET/GET/EXISTS} {
43c9dc7b 385 $r set emptykey {}
386 set res [$r get emptykey]
387 append res [$r exists emptykey]
388 $r del emptykey
389 append res [$r exists emptykey]
ed9b544e 390 } {10}
391
392 test {Commands pipelining} {
43c9dc7b 393 set fd [$r channel]
ed9b544e 394 puts -nonewline $fd "SET k1 4\r\nxyzk\r\nGET k1\r\nPING\r\n"
395 flush $fd
396 set res {}
43c9dc7b 397 append res [string match OK* [::redis::redis_read_reply $fd]]
398 append res [::redis::redis_read_reply $fd]
399 append res [string match PONG* [::redis::redis_read_reply $fd]]
ed9b544e 400 format $res
401 } {1xyzk1}
402
403 test {Non existing command} {
43c9dc7b 404 catch {$r foobaredcommand} err
405 string match ERR* $err
ed9b544e 406 } {1}
407
408 test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
43c9dc7b 409 $r lpush mylist a
410 $r lpush mylist b
411 $r rpush mylist c
412 set res [$r llen mylist]
413 append res [$r lindex mylist 0]
414 append res [$r lindex mylist 1]
415 append res [$r lindex mylist 2]
ab9d4cb1 416 list $res [$r lindex mylist 100]
417 } {3bac {}}
ed9b544e 418
419 test {DEL a list} {
43c9dc7b 420 $r del mylist
421 $r exists mylist
ed9b544e 422 } {0}
423
424 test {Create a long list and check every single element with LINDEX} {
425 set ok 0
426 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 427 $r rpush mylist $i
ed9b544e 428 }
429 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 430 if {[$r lindex mylist $i] eq $i} {incr ok}
431 if {[$r lindex mylist [expr (-$i)-1]] eq [expr 999-$i]} {
ed9b544e 432 incr ok
433 }
434 }
435 format $ok
436 } {2000}
437
438 test {Test elements with LINDEX in random access} {
439 set ok 0
440 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 441 set rint [expr int(rand()*1000)]
442 if {[$r lindex mylist $rint] eq $rint} {incr ok}
443 if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
ed9b544e 444 incr ok
445 }
446 }
447 format $ok
448 } {2000}
449
210e29f7 450 test {Check if the list is still ok after a DEBUG RELOAD} {
451 $r debug reload
452 set ok 0
453 for {set i 0} {$i < 1000} {incr i} {
454 set rint [expr int(rand()*1000)]
455 if {[$r lindex mylist $rint] eq $rint} {incr ok}
456 if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
457 incr ok
458 }
459 }
460 format $ok
461 } {2000}
462
ed9b544e 463 test {LLEN against non-list value error} {
43c9dc7b 464 $r del mylist
465 $r set mylist foobar
466 catch {$r llen mylist} err
467 format $err
c937aa89 468 } {ERR*}
ed9b544e 469
ab9d4cb1 470 test {LLEN against non existing key} {
471 $r llen not-a-key
472 } {0}
473
ed9b544e 474 test {LINDEX against non-list value error} {
43c9dc7b 475 catch {$r lindex mylist 0} err
476 format $err
c937aa89 477 } {ERR*}
ed9b544e 478
ab9d4cb1 479 test {LINDEX against non existing key} {
480 $r lindex not-a-key 10
481 } {}
482
ed9b544e 483 test {LPUSH against non-list value error} {
43c9dc7b 484 catch {$r lpush mylist 0} err
485 format $err
c937aa89 486 } {ERR*}
ed9b544e 487
488 test {RPUSH against non-list value error} {
43c9dc7b 489 catch {$r rpush mylist 0} err
490 format $err
c937aa89 491 } {ERR*}
ed9b544e 492
c08f1734 493 test {RPOPLPUSH base case} {
494 $r del mylist
495 $r rpush mylist a
496 $r rpush mylist b
497 $r rpush mylist c
498 $r rpush mylist d
499 set v1 [$r rpoplpush mylist newlist]
500 set v2 [$r rpoplpush mylist newlist]
501 set l1 [$r lrange mylist 0 -1]
502 set l2 [$r lrange newlist 0 -1]
503 list $v1 $v2 $l1 $l2
504 } {d c {a b} {c d}}
505
506 test {RPOPLPUSH with the same list as src and dst} {
507 $r del mylist
508 $r rpush mylist a
509 $r rpush mylist b
510 $r rpush mylist c
511 set l1 [$r lrange mylist 0 -1]
512 set v [$r rpoplpush mylist mylist]
513 set l2 [$r lrange mylist 0 -1]
514 list $l1 $v $l2
515 } {{a b c} c {c a b}}
516
517 test {RPOPLPUSH target list already exists} {
518 $r del mylist
519 $r del newlist
520 $r rpush mylist a
521 $r rpush mylist b
522 $r rpush mylist c
523 $r rpush mylist d
524 $r rpush newlist x
525 set v1 [$r rpoplpush mylist newlist]
526 set v2 [$r rpoplpush mylist newlist]
527 set l1 [$r lrange mylist 0 -1]
528 set l2 [$r lrange newlist 0 -1]
529 list $v1 $v2 $l1 $l2
530 } {d c {a b} {c d x}}
531
b9bb7ba2 532 test {RPOPLPUSH against non existing key} {
533 $r del mylist
534 $r del newlist
535 set v1 [$r rpoplpush mylist newlist]
536 list $v1 [$r exists mylist] [$r exists newlist]
537 } {{} 0 0}
538
539 test {RPOPLPUSH against non list src key} {
540 $r del mylist
541 $r del newlist
542 $r set mylist x
543 catch {$r rpoplpush mylist newlist} err
544 list [$r type mylist] [$r exists newlist] [string range $err 0 2]
545 } {string 0 ERR}
546
547 test {RPOPLPUSH against non list dst key} {
548 $r del mylist
549 $r del newlist
550 $r rpush mylist a
551 $r rpush mylist b
552 $r rpush mylist c
553 $r rpush mylist d
554 $r set newlist x
555 catch {$r rpoplpush mylist newlist} err
556 list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2]
557 } {{a b c d} string ERR}
558
fdcaae84 559 test {RPOPLPUSH against non existing src key} {
560 $r del mylist
561 $r del newlist
562 $r rpoplpush mylist newlist
563 } {}
564
ed9b544e 565 test {RENAME basic usage} {
43c9dc7b 566 $r set mykey hello
567 $r rename mykey mykey1
568 $r rename mykey1 mykey2
569 $r get mykey2
ed9b544e 570 } {hello}
571
572 test {RENAME source key should no longer exist} {
43c9dc7b 573 $r exists mykey
ed9b544e 574 } {0}
575
576 test {RENAME against already existing key} {
43c9dc7b 577 $r set mykey a
578 $r set mykey2 b
579 $r rename mykey2 mykey
580 set res [$r get mykey]
581 append res [$r exists mykey2]
ed9b544e 582 } {b0}
583
584 test {RENAMENX basic usage} {
43c9dc7b 585 $r del mykey
586 $r del mykey2
587 $r set mykey foobar
588 $r renamenx mykey mykey2
589 set res [$r get mykey2]
590 append res [$r exists mykey]
ed9b544e 591 } {foobar0}
592
593 test {RENAMENX against already existing key} {
43c9dc7b 594 $r set mykey foo
595 $r set mykey2 bar
596 $r renamenx mykey mykey2
ed9b544e 597 } {0}
598
599 test {RENAMENX against already existing key (2)} {
43c9dc7b 600 set res [$r get mykey]
601 append res [$r get mykey2]
ed9b544e 602 } {foobar}
603
604 test {RENAME against non existing source key} {
43c9dc7b 605 catch {$r rename nokey foobar} err
606 format $err
c937aa89 607 } {ERR*}
ed9b544e 608
609 test {RENAME where source and dest key is the same} {
43c9dc7b 610 catch {$r rename mykey mykey} err
611 format $err
c937aa89 612 } {ERR*}
ed9b544e 613
614 test {DEL all keys again (DB 0)} {
43c9dc7b 615 foreach key [$r keys *] {
616 $r del $key
ed9b544e 617 }
43c9dc7b 618 $r dbsize
ed9b544e 619 } {0}
620
621 test {DEL all keys again (DB 1)} {
eea4baf7 622 $r select 10
43c9dc7b 623 foreach key [$r keys *] {
624 $r del $key
ed9b544e 625 }
43c9dc7b 626 set res [$r dbsize]
eea4baf7 627 $r select 9
ed9b544e 628 format $res
629 } {0}
630
631 test {MOVE basic usage} {
43c9dc7b 632 $r set mykey foobar
eea4baf7 633 $r move mykey 10
ed9b544e 634 set res {}
43c9dc7b 635 lappend res [$r exists mykey]
636 lappend res [$r dbsize]
eea4baf7 637 $r select 10
43c9dc7b 638 lappend res [$r get mykey]
639 lappend res [$r dbsize]
eea4baf7 640 $r select 9
ed9b544e 641 format $res
642 } [list 0 0 foobar 1]
643
644 test {MOVE against key existing in the target DB} {
43c9dc7b 645 $r set mykey hello
eea4baf7 646 $r move mykey 10
ed9b544e 647 } {0}
648
649 test {SET/GET keys in different DBs} {
43c9dc7b 650 $r set a hello
651 $r set b world
eea4baf7 652 $r select 10
43c9dc7b 653 $r set a foo
654 $r set b bared
eea4baf7 655 $r select 9
ed9b544e 656 set res {}
43c9dc7b 657 lappend res [$r get a]
658 lappend res [$r get b]
eea4baf7 659 $r select 10
43c9dc7b 660 lappend res [$r get a]
661 lappend res [$r get b]
eea4baf7 662 $r select 9
ed9b544e 663 format $res
664 } {hello world foo bared}
665
666 test {Basic LPOP/RPOP} {
43c9dc7b 667 $r del mylist
668 $r rpush mylist 1
669 $r rpush mylist 2
670 $r lpush mylist 0
671 list [$r lpop mylist] [$r rpop mylist] [$r lpop mylist] [$r llen mylist]
ed9b544e 672 } [list 0 2 1 0]
673
674 test {LPOP/RPOP against empty list} {
43c9dc7b 675 $r lpop mylist
ed9b544e 676 } {}
677
678 test {LPOP against non list value} {
43c9dc7b 679 $r set notalist foo
680 catch {$r lpop notalist} err
681 format $err
c937aa89 682 } {ERR*kind*}
ed9b544e 683
684 test {Mass LPUSH/LPOP} {
685 set sum 0
686 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 687 $r lpush mylist $i
ed9b544e 688 incr sum $i
689 }
690 set sum2 0
691 for {set i 0} {$i < 500} {incr i} {
43c9dc7b 692 incr sum2 [$r lpop mylist]
693 incr sum2 [$r rpop mylist]
ed9b544e 694 }
695 expr $sum == $sum2
696 } {1}
697
698 test {LRANGE basics} {
699 for {set i 0} {$i < 10} {incr i} {
43c9dc7b 700 $r rpush mylist $i
ed9b544e 701 }
43c9dc7b 702 list [$r lrange mylist 1 -2] \
703 [$r lrange mylist -3 -1] \
704 [$r lrange mylist 4 4]
ed9b544e 705 } {{1 2 3 4 5 6 7 8} {7 8 9} 4}
706
707 test {LRANGE inverted indexes} {
43c9dc7b 708 $r lrange mylist 6 2
ed9b544e 709 } {}
710
711 test {LRANGE out of range indexes including the full list} {
43c9dc7b 712 $r lrange mylist -1000 1000
ed9b544e 713 } {0 1 2 3 4 5 6 7 8 9}
714
715 test {LRANGE against non existing key} {
43c9dc7b 716 $r lrange nosuchkey 0 1
ed9b544e 717 } {}
718
719 test {LTRIM basics} {
43c9dc7b 720 $r del mylist
ed9b544e 721 for {set i 0} {$i < 100} {incr i} {
43c9dc7b 722 $r lpush mylist $i
723 $r ltrim mylist 0 4
ed9b544e 724 }
43c9dc7b 725 $r lrange mylist 0 -1
ed9b544e 726 } {99 98 97 96 95}
727
c632369b 728 test {LTRIM stress testing} {
729 set mylist {}
730 set err {}
731 for {set i 0} {$i < 20} {incr i} {
732 lappend mylist $i
733 }
734
735 for {set j 0} {$j < 100} {incr j} {
736 # Fill the list
737 $r del mylist
738 for {set i 0} {$i < 20} {incr i} {
739 $r rpush mylist $i
740 }
741 # Trim at random
742 set a [randomInt 20]
743 set b [randomInt 20]
744 $r ltrim mylist $a $b
745 if {[$r lrange mylist 0 -1] ne [lrange $mylist $a $b]} {
746 set err "[$r lrange mylist 0 -1] != [lrange $mylist $a $b]"
747 break
748 }
749 }
750 set _ $err
751 } {}
752
ed9b544e 753 test {LSET} {
c632369b 754 $r del mylist
755 foreach x {99 98 97 96 95} {
756 $r rpush mylist $x
757 }
43c9dc7b 758 $r lset mylist 1 foo
759 $r lset mylist -1 bar
760 $r lrange mylist 0 -1
ed9b544e 761 } {99 foo 97 96 bar}
762
763 test {LSET out of range index} {
43c9dc7b 764 catch {$r lset mylist 10 foo} err
765 format $err
c937aa89 766 } {ERR*range*}
ed9b544e 767
768 test {LSET against non existing key} {
43c9dc7b 769 catch {$r lset nosuchkey 10 foo} err
770 format $err
c937aa89 771 } {ERR*key*}
ed9b544e 772
773 test {LSET against non list value} {
43c9dc7b 774 $r set nolist foobar
775 catch {$r lset nolist 0 foo} err
776 format $err
c937aa89 777 } {ERR*value*}
ed9b544e 778
779 test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
43c9dc7b 780 $r sadd myset foo
781 $r sadd myset bar
782 list [$r scard myset] [$r sismember myset foo] \
783 [$r sismember myset bar] [$r sismember myset bla] \
784 [lsort [$r smembers myset]]
ed9b544e 785 } {2 1 1 0 {bar foo}}
786
787 test {SADD adding the same element multiple times} {
43c9dc7b 788 $r sadd myset foo
789 $r sadd myset foo
790 $r sadd myset foo
791 $r scard myset
ed9b544e 792 } {2}
793
794 test {SADD against non set} {
43c9dc7b 795 catch {$r sadd mylist foo} err
796 format $err
c937aa89 797 } {ERR*kind*}
ed9b544e 798
799 test {SREM basics} {
43c9dc7b 800 $r sadd myset ciao
801 $r srem myset foo
802 lsort [$r smembers myset]
ed9b544e 803 } {bar ciao}
804
805 test {Mass SADD and SINTER with two sets} {
806 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 807 $r sadd set1 $i
808 $r sadd set2 [expr $i+995]
ed9b544e 809 }
43c9dc7b 810 lsort [$r sinter set1 set2]
ed9b544e 811 } {995 996 997 998 999}
40d224a9 812
813 test {SUNION with two sets} {
814 lsort [$r sunion set1 set2]
815 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
ed9b544e 816
817 test {SINTERSTORE with two sets} {
43c9dc7b 818 $r sinterstore setres set1 set2
819 lsort [$r smembers setres]
ed9b544e 820 } {995 996 997 998 999}
821
210e29f7 822 test {SINTERSTORE with two sets, after a DEBUG RELOAD} {
823 $r debug reload
824 $r sinterstore setres set1 set2
825 lsort [$r smembers setres]
826 } {995 996 997 998 999}
827
40d224a9 828 test {SUNIONSTORE with two sets} {
829 $r sunionstore setres set1 set2
830 lsort [$r smembers setres]
831 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
832
f4d9b3c6 833 test {SUNIONSTORE against non existing keys} {
834 $r set setres xxx
835 list [$r sunionstore setres foo111 bar222] [$r exists xxx]
836 } {0 0}
837
ed9b544e 838 test {SINTER against three sets} {
43c9dc7b 839 $r sadd set3 999
840 $r sadd set3 995
841 $r sadd set3 1000
842 $r sadd set3 2000
843 lsort [$r sinter set1 set2 set3]
ed9b544e 844 } {995 999}
845
846 test {SINTERSTORE with three sets} {
43c9dc7b 847 $r sinterstore setres set1 set2 set3
848 lsort [$r smembers setres]
ed9b544e 849 } {995 999}
40d224a9 850
851 test {SUNION with non existing keys} {
852 lsort [$r sunion nokey1 set1 set2 nokey2]
853 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
854
f4f56e1d 855 test {SDIFF with two sets} {
856 for {set i 5} {$i < 1000} {incr i} {
857 $r sadd set4 $i
858 }
859 lsort [$r sdiff set1 set4]
860 } {0 1 2 3 4}
861
862 test {SDIFF with three sets} {
863 $r sadd set5 0
864 lsort [$r sdiff set1 set4 set5]
865 } {1 2 3 4}
866
867 test {SDIFFSTORE with three sets} {
868 $r sdiffstore sres set1 set4 set5
869 lsort [$r smembers sres]
870 } {1 2 3 4}
871
12fea928 872 test {SPOP basics} {
873 $r del myset
874 $r sadd myset 1
875 $r sadd myset 2
876 $r sadd myset 3
877 list [lsort [list [$r spop myset] [$r spop myset] [$r spop myset]]] [$r scard myset]
878 } {{1 2 3} 0}
879
ed9b544e 880 test {SAVE - make sure there are all the types as values} {
bbf44ecf 881 # Wait for a background saving in progress to terminate
0d36ded0 882 waitForBgsave $r
43c9dc7b 883 $r lpush mysavelist hello
884 $r lpush mysavelist world
885 $r set myemptykey {}
886 $r set mynormalkey {blablablba}
d7f43c08 887 $r zadd mytestzset a 10
888 $r zadd mytestzset b 20
889 $r zadd mytestzset c 30
43c9dc7b 890 $r save
c937aa89 891 } {OK}
6cbfd2b3 892
893 test {SRANDMEMBER} {
894 $r del myset
895 $r sadd myset a
896 $r sadd myset b
897 $r sadd myset c
898 unset -nocomplain myset
899 array set myset {}
900 for {set i 0} {$i < 100} {incr i} {
901 set myset([$r srandmember myset]) 1
902 }
903 lsort [array names myset]
904 } {a b c}
ed9b544e 905
98e1bb81 906 test {Create a random list and a random set} {
ed9b544e 907 set tosort {}
908 array set seenrand {}
909 for {set i 0} {$i < 10000} {incr i} {
910 while 1 {
911 # Make sure all the weights are different because
912 # Redis does not use a stable sort but Tcl does.
98e1bb81 913 randpath {
914 set rint [expr int(rand()*1000000)]
915 } {
916 set rint [expr rand()]
917 }
43c9dc7b 918 if {![info exists seenrand($rint)]} break
ed9b544e 919 }
43c9dc7b 920 set seenrand($rint) x
921 $r lpush tosort $i
98e1bb81 922 $r sadd tosort-set $i
43c9dc7b 923 $r set weight_$i $rint
924 lappend tosort [list $i $rint]
ed9b544e 925 }
926 set sorted [lsort -index 1 -real $tosort]
927 set res {}
928 for {set i 0} {$i < 10000} {incr i} {
929 lappend res [lindex $sorted $i 0]
930 }
931 format {}
932 } {}
933
934 test {SORT with BY against the newly created list} {
43c9dc7b 935 $r sort tosort {BY weight_*}
ed9b544e 936 } $res
937
98e1bb81 938 test {the same SORT with BY, but against the newly created set} {
939 $r sort tosort-set {BY weight_*}
940 } $res
941
5384a2d8 942 test {SORT with BY and STORE against the newly created list} {
943 $r sort tosort {BY weight_*} store sort-res
944 $r lrange sort-res 0 -1
945 } $res
946
ed9b544e 947 test {SORT direct, numeric, against the newly created list} {
43c9dc7b 948 $r sort tosort
ed9b544e 949 } [lsort -integer $res]
950
951 test {SORT decreasing sort} {
43c9dc7b 952 $r sort tosort {DESC}
ed9b544e 953 } [lsort -decreasing -integer $res]
954
9ebed7cf 955while 1 {
ed9b544e 956 test {SORT speed, sorting 10000 elements list using BY, 100 times} {
957 set start [clock clicks -milliseconds]
958 for {set i 0} {$i < 100} {incr i} {
43c9dc7b 959 set sorted [$r sort tosort {BY weight_* LIMIT 0 10}]
ed9b544e 960 }
961 set elapsed [expr [clock clicks -milliseconds]-$start]
962 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
963 flush stdout
964 format {}
965 } {}
9ebed7cf 966}
ed9b544e 967 test {SORT speed, sorting 10000 elements list directly, 100 times} {
968 set start [clock clicks -milliseconds]
969 for {set i 0} {$i < 100} {incr i} {
43c9dc7b 970 set sorted [$r sort tosort {LIMIT 0 10}]
ed9b544e 971 }
972 set elapsed [expr [clock clicks -milliseconds]-$start]
973 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
974 flush stdout
975 format {}
976 } {}
977
978 test {SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times} {
979 set start [clock clicks -milliseconds]
980 for {set i 0} {$i < 100} {incr i} {
43c9dc7b 981 set sorted [$r sort tosort {BY nokey LIMIT 0 10}]
ed9b544e 982 }
983 set elapsed [expr [clock clicks -milliseconds]-$start]
984 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
985 flush stdout
986 format {}
987 } {}
988
989 test {SORT regression for issue #19, sorting floats} {
43c9dc7b 990 $r flushdb
ed9b544e 991 foreach x {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15} {
43c9dc7b 992 $r lpush mylist $x
ed9b544e 993 }
43c9dc7b 994 $r sort mylist
ed9b544e 995 } [lsort -real {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}]
996
28173a49 997 test {SORT with GET #} {
998 $r del mylist
999 $r lpush mylist 1
1000 $r lpush mylist 2
1001 $r lpush mylist 3
1002 $r mset weight_1 10 weight_2 5 weight_3 30
1003 $r sort mylist BY weight_* GET #
1004 } {2 1 3}
1005
d922ae65 1006 test {SORT with constant GET} {
1007 $r sort mylist GET foo
1008 } {{} {} {}}
1009
ed9b544e 1010 test {LREM, remove all the occurrences} {
eea4baf7 1011 $r flushdb
43c9dc7b 1012 $r rpush mylist foo
1013 $r rpush mylist bar
1014 $r rpush mylist foobar
1015 $r rpush mylist foobared
1016 $r rpush mylist zap
1017 $r rpush mylist bar
1018 $r rpush mylist test
1019 $r rpush mylist foo
1020 set res [$r lrem mylist 0 bar]
1021 list [$r lrange mylist 0 -1] $res
ed9b544e 1022 } {{foo foobar foobared zap test foo} 2}
1023
1024 test {LREM, remove the first occurrence} {
43c9dc7b 1025 set res [$r lrem mylist 1 foo]
1026 list [$r lrange mylist 0 -1] $res
ed9b544e 1027 } {{foobar foobared zap test foo} 1}
1028
1029 test {LREM, remove non existing element} {
43c9dc7b 1030 set res [$r lrem mylist 1 nosuchelement]
1031 list [$r lrange mylist 0 -1] $res
ed9b544e 1032 } {{foobar foobared zap test foo} 0}
1033
1034 test {LREM, starting from tail with negative count} {
eea4baf7 1035 $r flushdb
43c9dc7b 1036 $r rpush mylist foo
1037 $r rpush mylist bar
1038 $r rpush mylist foobar
1039 $r rpush mylist foobared
1040 $r rpush mylist zap
1041 $r rpush mylist bar
1042 $r rpush mylist test
1043 $r rpush mylist foo
1044 $r rpush mylist foo
1045 set res [$r lrem mylist -1 bar]
1046 list [$r lrange mylist 0 -1] $res
ed9b544e 1047 } {{foo bar foobar foobared zap test foo foo} 1}
1048
1049 test {LREM, starting from tail with negative count (2)} {
43c9dc7b 1050 set res [$r lrem mylist -2 foo]
1051 list [$r lrange mylist 0 -1] $res
ed9b544e 1052 } {{foo bar foobar foobared zap test} 2}
1053
724a51b1 1054 test {LREM, deleting objects that may be encoded as integers} {
1055 $r lpush myotherlist 1
1056 $r lpush myotherlist 2
1057 $r lpush myotherlist 3
1058 $r lrem myotherlist 1 2
1059 $r llen myotherlist
1060 } {2}
1061
5b19bd72 1062 test {MGET} {
eea4baf7 1063 $r flushdb
43c9dc7b 1064 $r set foo BAR
1065 $r set bar FOO
1066 $r mget foo bar
5b19bd72 1067 } {BAR FOO}
1068
1069 test {MGET against non existing key} {
43c9dc7b 1070 $r mget foo baazz bar
5b19bd72 1071 } {BAR {} FOO}
1072
1073 test {MGET against non-string key} {
43c9dc7b 1074 $r sadd myset ciao
1075 $r sadd myset bau
1076 $r mget foo baazz bar myset
5b19bd72 1077 } {BAR {} FOO {}}
1078
ce7bef07 1079 test {RANDOMKEY} {
eea4baf7 1080 $r flushdb
ce7bef07 1081 $r set foo x
1082 $r set bar y
1083 set foo_seen 0
1084 set bar_seen 0
1085 for {set i 0} {$i < 100} {incr i} {
1086 set rkey [$r randomkey]
1087 if {$rkey eq {foo}} {
1088 set foo_seen 1
1089 }
1090 if {$rkey eq {bar}} {
1091 set bar_seen 1
1092 }
1093 }
1094 list $foo_seen $bar_seen
1095 } {1 1}
1096
1097 test {RANDOMKEY against empty DB} {
eea4baf7 1098 $r flushdb
ce7bef07 1099 $r randomkey
1100 } {}
1101
f5785ae9 1102 test {RANDOMKEY regression 1} {
eea4baf7 1103 $r flushdb
f5785ae9 1104 $r set x 10
1105 $r del x
1106 $r randomkey
1107 } {}
1108
7ac6d461 1109 test {GETSET (set new value)} {
1110 list [$r getset foo xyz] [$r get foo]
1111 } {{} xyz}
1112
1113 test {GETSET (replace old value)} {
1114 $r set foo bar
1115 list [$r getset foo xyz] [$r get foo]
1116 } {bar xyz}
1117
0eeb2a4b 1118 test {SMOVE basics} {
1119 $r sadd myset1 a
1120 $r sadd myset1 b
1121 $r sadd myset1 c
1122 $r sadd myset2 x
1123 $r sadd myset2 y
1124 $r sadd myset2 z
1125 $r smove myset1 myset2 a
1126 list [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
1127 } {{a x y z} {b c}}
1128
1129 test {SMOVE non existing key} {
1130 list [$r smove myset1 myset2 foo] [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
1131 } {0 {a x y z} {b c}}
1132
1133 test {SMOVE non existing src set} {
1134 list [$r smove noset myset2 foo] [lsort [$r smembers myset2]]
1135 } {0 {a x y z}}
1136
1137 test {SMOVE non existing dst set} {
1138 list [$r smove myset2 myset3 y] [lsort [$r smembers myset2]] [lsort [$r smembers myset3]]
1139 } {1 {a x z} y}
1140
1141 test {SMOVE wrong src key type} {
1142 $r set x 10
1143 catch {$r smove x myset2 foo} err
1144 format $err
1145 } {ERR*}
1146
1147 test {SMOVE wrong dst key type} {
1148 $r set x 10
1149 catch {$r smove myset2 x foo} err
1150 format $err
1151 } {ERR*}
1152
f69f2cba 1153 test {MSET base case} {
1154 $r mset x 10 y "foo bar" z "x x x x x x x\n\n\r\n"
1155 $r mget x y z
1156 } [list 10 {foo bar} "x x x x x x x\n\n\r\n"]
1157
1158 test {MSET wrong number of args} {
1159 catch {$r mset x 10 y "foo bar" z} err
1160 format $err
1161 } {*wrong number*}
1162
1163 test {MSETNX with already existent key} {
1164 list [$r msetnx x1 xxx y2 yyy x 20] [$r exists x1] [$r exists y2]
1165 } {0 0 0}
1166
1167 test {MSETNX with not existing keys} {
1168 list [$r msetnx x1 xxx y2 yyy] [$r get x1] [$r get y2]
1169 } {1 xxx yyy}
1170
5acdc75d 1171 test {MSETNX should remove all the volatile keys even on failure} {
1172 $r mset x 1 y 2 z 3
1173 $r expire y 10000
1174 $r expire z 10000
1175 list [$r msetnx x A y B z C] [$r mget x y z]
1176 } {0 {1 {} {}}}
1177
d7f43c08 1178 test {ZSET basic ZADD and score update} {
1179 $r zadd ztmp 10 x
1180 $r zadd ztmp 20 y
1181 $r zadd ztmp 30 z
1182 set aux1 [$r zrange ztmp 0 -1]
1183 $r zadd ztmp 1 y
1184 set aux2 [$r zrange ztmp 0 -1]
1185 list $aux1 $aux2
1186 } {{x y z} {y x z}}
1187
fc77604c 1188 test {ZCARD basics} {
1189 $r zcard ztmp
1190 } {3}
1191
1192 test {ZCARD non existing key} {
1193 $r zcard ztmp-blabla
1194 } {0}
1195
d7f43c08 1196 test {ZSCORE} {
eaa256ad 1197 set aux {}
1198 set err {}
1199 for {set i 0} {$i < 1000} {incr i} {
1200 set score [expr rand()]
1201 lappend aux $score
1202 $r zadd zscoretest $score $i
1203 }
1204 for {set i 0} {$i < 1000} {incr i} {
1205 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
1206 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
1207 break
1208 }
1209 }
1210 set _ $err
1211 } {}
d7f43c08 1212
210e29f7 1213 test {ZSCORE after a DEBUG RELOAD} {
1214 set aux {}
1215 set err {}
1216 $r del zscoretest
1217 for {set i 0} {$i < 1000} {incr i} {
1218 set score [expr rand()]
1219 lappend aux $score
1220 $r zadd zscoretest $score $i
1221 }
1222 $r debug reload
1223 for {set i 0} {$i < 1000} {incr i} {
1224 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
1225 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
1226 break
1227 }
1228 }
1229 set _ $err
1230 } {}
1231
ac945e2d 1232 test {ZRANGE and ZREVRANGE basics} {
04c71068 1233 list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1] \
1234 [$r zrange ztmp 1 -1] [$r zrevrange ztmp 1 -1]
1235 } {{y x z} {z x y} {x z} {x y}}
d7f43c08 1236
81d45645 1237 test {ZRANGE WITHSCORES} {
1238 $r zrange ztmp 0 -1 withscores
1239 } {y 1 x 10 z 30}
1240
d7f43c08 1241 test {ZSETs stress tester - sorting is working well?} {
1242 set delta 0
1243 for {set test 0} {$test < 2} {incr test} {
1244 unset -nocomplain auxarray
1245 array set auxarray {}
1246 set auxlist {}
1247 $r del myzset
1248 for {set i 0} {$i < 1000} {incr i} {
1249 if {$test == 0} {
1250 set score [expr rand()]
1251 } else {
1252 set score [expr int(rand()*10)]
1253 }
1254 set auxarray($i) $score
1255 $r zadd myzset $score $i
1256 # Random update
1257 if {[expr rand()] < .2} {
1258 set j [expr int(rand()*1000)]
1259 if {$test == 0} {
1260 set score [expr rand()]
1261 } else {
1262 set score [expr int(rand()*10)]
1263 }
1264 set auxarray($j) $score
1265 $r zadd myzset $score $j
1266 }
1267 }
1268 foreach {item score} [array get auxarray] {
1269 lappend auxlist [list $score $item]
1270 }
1271 set sorted [lsort -command zlistAlikeSort $auxlist]
1272 set auxlist {}
1273 foreach x $sorted {
1274 lappend auxlist [lindex $x 1]
1275 }
1276 set fromredis [$r zrange myzset 0 -1]
1277 set delta 0
1278 for {set i 0} {$i < [llength $fromredis]} {incr i} {
1279 if {[lindex $fromredis $i] != [lindex $auxlist $i]} {
1280 incr delta
1281 }
1282 }
1283 }
1284 format $delta
1285 } {0}
1286
28173a49 1287 test {ZINCRBY - can create a new sorted set} {
1288 $r del zset
1289 $r zincrby zset 1 foo
1290 list [$r zrange zset 0 -1] [$r zscore zset foo]
1291 } {foo 1}
1292
1293 test {ZINCRBY - increment and decrement} {
1294 $r zincrby zset 2 foo
1295 $r zincrby zset 1 bar
1296 set v1 [$r zrange zset 0 -1]
1297 $r zincrby zset 10 bar
1298 $r zincrby zset -5 foo
1299 $r zincrby zset -5 bar
1300 set v2 [$r zrange zset 0 -1]
1301 list $v1 $v2 [$r zscore zset foo] [$r zscore zset bar]
1302 } {{bar foo} {foo bar} -2 6}
1303
223a0591 1304 test {ZRANGEBYSCORE and ZCOUNT basics} {
c74e7c77 1305 $r del zset
1306 $r zadd zset 1 a
1307 $r zadd zset 2 b
1308 $r zadd zset 3 c
1309 $r zadd zset 4 d
1310 $r zadd zset 5 e
223a0591 1311 list [$r zrangebyscore zset 2 4] [$r zrangebyscore zset (2 (4] \
1312 [$r zcount zset 2 4] [$r zcount zset (2 (4]
1313 } {{b c d} c 3 1}
c74e7c77 1314
0500ef27
SH
1315 test {ZRANGEBYSCORE withscores} {
1316 $r del zset
1317 $r zadd zset 1 a
1318 $r zadd zset 2 b
1319 $r zadd zset 3 c
1320 $r zadd zset 4 d
1321 $r zadd zset 5 e
1322 $r zrangebyscore zset 2 4 withscores
1323 } {b 2 c 3 d 4}
1324
5b1207c6 1325 test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
1326 set err {}
1327 $r del zset
1328 for {set i 0} {$i < 1000} {incr i} {
1329 $r zadd zset [expr rand()] $i
1330 }
1331 for {set i 0} {$i < 100} {incr i} {
1332 set min [expr rand()]
1333 set max [expr rand()]
1334 if {$min > $max} {
1335 set aux $min
1336 set min $max
1337 set max $aux
1338 }
1339 set low [$r zrangebyscore zset -inf $min]
1340 set ok [$r zrangebyscore zset $min $max]
1341 set high [$r zrangebyscore zset $max +inf]
223a0591 1342 set lowx [$r zrangebyscore zset -inf ($min]
1343 set okx [$r zrangebyscore zset ($min ($max]
1344 set highx [$r zrangebyscore zset ($max +inf]
1345
1346 if {[$r zcount zset -inf $min] != [llength $low]} {
1347 append err "Error, len does not match zcount\n"
1348 }
1349 if {[$r zcount zset $min $max] != [llength $ok]} {
1350 append err "Error, len does not match zcount\n"
1351 }
1352 if {[$r zcount zset $max +inf] != [llength $high]} {
1353 append err "Error, len does not match zcount\n"
1354 }
1355 if {[$r zcount zset -inf ($min] != [llength $lowx]} {
1356 append err "Error, len does not match zcount\n"
1357 }
1358 if {[$r zcount zset ($min ($max] != [llength $okx]} {
1359 append err "Error, len does not match zcount\n"
1360 }
1361 if {[$r zcount zset ($max +inf] != [llength $highx]} {
1362 append err "Error, len does not match zcount\n"
1363 }
1364
5b1207c6 1365 foreach x $low {
1366 set score [$r zscore zset $x]
1367 if {$score > $min} {
1368 append err "Error, score for $x is $score > $min\n"
1369 }
1370 }
223a0591 1371 foreach x $lowx {
1372 set score [$r zscore zset $x]
1373 if {$score >= $min} {
1374 append err "Error, score for $x is $score >= $min\n"
1375 }
1376 }
5b1207c6 1377 foreach x $ok {
1378 set score [$r zscore zset $x]
1379 if {$score < $min || $score > $max} {
1380 append err "Error, score for $x is $score outside $min-$max range\n"
1381 }
1382 }
223a0591 1383 foreach x $okx {
1384 set score [$r zscore zset $x]
1385 if {$score <= $min || $score >= $max} {
1386 append err "Error, score for $x is $score outside $min-$max open range\n"
1387 }
1388 }
5b1207c6 1389 foreach x $high {
1390 set score [$r zscore zset $x]
1391 if {$score < $max} {
1392 append err "Error, score for $x is $score < $max\n"
1393 }
1394 }
223a0591 1395 foreach x $highx {
1396 set score [$r zscore zset $x]
1397 if {$score <= $max} {
1398 append err "Error, score for $x is $score <= $max\n"
1399 }
1400 }
5b1207c6 1401 }
1402 set _ $err
1403 } {}
1404
0b13687c 1405 test {ZRANGEBYSCORE with LIMIT} {
1406 $r del zset
1407 $r zadd zset 1 a
1408 $r zadd zset 2 b
1409 $r zadd zset 3 c
1410 $r zadd zset 4 d
1411 $r zadd zset 5 e
1412 list \
1413 [$r zrangebyscore zset 0 10 LIMIT 0 2] \
1414 [$r zrangebyscore zset 0 10 LIMIT 2 3] \
1415 [$r zrangebyscore zset 0 10 LIMIT 2 10] \
1416 [$r zrangebyscore zset 0 10 LIMIT 20 10]
1417 } {{a b} {c d e} {c d e} {}}
1418
0500ef27
SH
1419 test {ZRANGEBYSCORE with LIMIT and withscores} {
1420 $r del zset
1421 $r zadd zset 10 a
1422 $r zadd zset 20 b
1423 $r zadd zset 30 c
1424 $r zadd zset 40 d
1425 $r zadd zset 50 e
1426 $r zrangebyscore zset 20 50 LIMIT 2 3 withscores
1427 } {d 40 e 50}
1428
9c21a518 1429 test {ZREMRANGE basics} {
1430 $r del zset
1431 $r zadd zset 1 a
1432 $r zadd zset 2 b
1433 $r zadd zset 3 c
1434 $r zadd zset 4 d
1435 $r zadd zset 5 e
1436 list [$r zremrangebyscore zset 2 4] [$r zrange zset 0 -1]
1437 } {3 {a e}}
1438
1439 test {ZREMRANGE from -inf to +inf} {
1440 $r del zset
1441 $r zadd zset 1 a
1442 $r zadd zset 2 b
1443 $r zadd zset 3 c
1444 $r zadd zset 4 d
1445 $r zadd zset 5 e
1446 list [$r zremrangebyscore zset -inf +inf] [$r zrange zset 0 -1]
1447 } {5 {}}
1448
0b13687c 1449 test {SORT against sorted sets} {
1450 $r del zset
1451 $r zadd zset 1 a
1452 $r zadd zset 5 b
1453 $r zadd zset 2 c
1454 $r zadd zset 10 d
1455 $r zadd zset 3 e
1456 $r sort zset alpha desc
1457 } {e d c b a}
1458
c74e7c77 1459 test {Sorted sets +inf and -inf handling} {
1460 $r del zset
1461 $r zadd zset -100 a
1462 $r zadd zset 200 b
1463 $r zadd zset -300 c
1464 $r zadd zset 1000000 d
1465 $r zadd zset +inf max
1466 $r zadd zset -inf min
1467 $r zrange zset 0 -1
1468 } {min c a b d max}
1469
b9febaab 1470 test {EXPIRE - don't set timeouts multiple times} {
1471 $r set x foobar
1472 set v1 [$r expire x 5]
1473 set v2 [$r ttl x]
1474 set v3 [$r expire x 10]
1475 set v4 [$r ttl x]
1476 list $v1 $v2 $v3 $v4
1477 } {1 5 0 5}
1478
1479 test {EXPIRE - It should be still possible to read 'x'} {
1480 $r get x
1481 } {foobar}
1482
1483 test {EXPIRE - After 6 seconds the key should no longer be here} {
1484 after 6000
1485 list [$r get x] [$r exists x]
1486 } {{} 0}
1487
1488 test {EXPIRE - Delete on write policy} {
1489 $r del x
1490 $r lpush x foo
1491 $r expire x 1000
1492 $r lpush x bar
1493 $r lrange x 0 -1
1494 } {bar}
1495
5446315f 1496 test {EXPIREAT - Check for EXPIRE alike behavior} {
1497 $r del x
1498 $r set x foo
1499 $r expireat x [expr [clock seconds]+15]
1500 $r ttl x
1501 } {1[345]}
1502
d7f43c08 1503 test {ZSETs skiplist implementation backlink consistency test} {
1504 set diff 0
1505 set elements 10000
1506 for {set j 0} {$j < $elements} {incr j} {
1507 $r zadd myzset [expr rand()] "Element-$j"
1508 $r zrem myzset "Element-[expr int(rand()*$elements)]"
1509 }
1510 set l1 [$r zrange myzset 0 -1]
1511 set l2 [$r zrevrange myzset 0 -1]
1512 for {set j 0} {$j < [llength $l1]} {incr j} {
1513 if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
1514 incr diff
1515 }
1516 }
1517 format $diff
1518 } {0}
1519
75398fbc 1520 foreach fuzztype {binary alpha compr} {
1521 test "FUZZ stresser with data model $fuzztype" {
1522 set err 0
f69f2cba 1523 for {set i 0} {$i < 10000} {incr i} {
75398fbc 1524 set fuzz [randstring 0 512 $fuzztype]
1525 $r set foo $fuzz
1526 set got [$r get foo]
1527 if {$got ne $fuzz} {
f69f2cba 1528 set err [list $fuzz $got]
75398fbc 1529 break
1530 }
1531 }
f69f2cba 1532 set _ $err
75398fbc 1533 } {0}
1534 }
1535
0d36ded0 1536 test {BGSAVE} {
7c775e09 1537 waitForBgsave $r
0d36ded0 1538 $r flushdb
1539 $r save
1540 $r set x 10
1541 $r bgsave
1542 waitForBgsave $r
1543 $r debug reload
1544 $r get x
1545 } {10}
1546
7c49733c 1547 test {Handle an empty query well} {
1548 set fd [$r channel]
1549 puts -nonewline $fd "\r\n"
1550 flush $fd
1551 $r ping
1552 } {PONG}
1553
1554 test {Negative multi bulk command does not create problems} {
1555 set fd [$r channel]
1556 puts -nonewline $fd "*-10\r\n"
1557 flush $fd
1558 $r ping
1559 } {PONG}
1560
1561 test {Negative multi bulk payload} {
1562 set fd [$r channel]
1563 puts -nonewline $fd "SET x -10\r\n"
1564 flush $fd
1565 gets $fd
1566 } {*invalid bulk*}
1567
1568 test {Too big bulk payload} {
1569 set fd [$r channel]
1570 puts -nonewline $fd "SET x 2000000000\r\n"
1571 flush $fd
1572 gets $fd
1573 } {*invalid bulk*count*}
1574
1575 test {Multi bulk request not followed by bulk args} {
1576 set fd [$r channel]
1577 puts -nonewline $fd "*1\r\nfoo\r\n"
1578 flush $fd
1579 gets $fd
1580 } {*protocol error*}
1581
1582 test {Generic wrong number of args} {
1583 catch {$r ping x y z} err
1584 set _ $err
1585 } {*wrong*arguments*ping*}
1586
1587 test {SELECT an out of range DB} {
1588 catch {$r select 1000000} err
1589 set _ $err
1590 } {*invalid*}
1591
e054afda 1592 if {![catch {package require sha1}]} {
1593 test {Check consistency of different data types after a reload} {
1594 $r flushdb
1595 createComplexDataset $r 10000
1596 set sha1 [datasetDigest $r]
1597 $r debug reload
1598 set sha1_after [datasetDigest $r]
1599 expr {$sha1 eq $sha1_after}
1600 } {1}
e96e4fbf 1601
1602 test {Same dataset digest if saving/reloading as AOF?} {
1603 $r bgrewriteaof
1604 waitForBgrewriteaof $r
1605 $r debug loadaof
1606 set sha1_after [datasetDigest $r]
1607 expr {$sha1 eq $sha1_after}
1608 } {1}
e054afda 1609 }
1610
e96e4fbf 1611 test {EXPIRES after a reload (snapshot + append only file)} {
71c2b467 1612 $r flushdb
1613 $r set x 10
1614 $r expire x 1000
1615 $r save
1616 $r debug reload
1617 set ttl [$r ttl x]
e96e4fbf 1618 set e1 [expr {$ttl > 900 && $ttl <= 1000}]
1619 $r bgrewriteaof
1620 waitForBgrewriteaof $r
1621 set ttl [$r ttl x]
1622 set e2 [expr {$ttl > 900 && $ttl <= 1000}]
1623 list $e1 $e2
1624 } {1 1}
71c2b467 1625
483049a7 1626 test {PIPELINING stresser (also a regression for the old epoll bug)} {
1627 set fd2 [socket 127.0.0.1 6379]
1628 fconfigure $fd2 -encoding binary -translation binary
0447be2e 1629 puts -nonewline $fd2 "SELECT 9\r\n"
1630 flush $fd2
1631 gets $fd2
483049a7 1632
1633 for {set i 0} {$i < 100000} {incr i} {
1634 set q {}
1635 set val "0000${i}0000"
1636 append q "SET key:$i [string length $val]\r\n$val\r\n"
1637 puts -nonewline $fd2 $q
1638 set q {}
1639 append q "GET key:$i\r\n"
1640 puts -nonewline $fd2 $q
1641 }
1642 flush $fd2
1643
1644 for {set i 0} {$i < 100000} {incr i} {
1645 gets $fd2 line
1646 gets $fd2 count
1647 set count [string range $count 1 end]
1648 set val [read $fd2 $count]
1649 read $fd2 2
1650 }
1651 close $fd2
1652 set _ 1
1653 } {1}
1654
4409877e 1655 test {MUTLI / EXEC basics} {
1656 $r del mylist
1657 $r rpush mylist a
1658 $r rpush mylist b
1659 $r rpush mylist c
1660 $r multi
1661 set v1 [$r lrange mylist 0 -1]
1662 set v2 [$r ping]
1663 set v3 [$r exec]
1664 list $v1 $v2 $v3
1665 } {QUEUED QUEUED {{a b c} PONG}}
1666
3c290b9b 1667 test {APPEND basics} {
1668 list [$r append foo bar] [$r get foo] \
1669 [$r append foo 100] [$r get foo]
1670 } {3 bar 6 bar100}
1671
1672 test {APPEND fuzzing} {
1673 set err {}
1674 foreach type {binary alpha compr} {
1675 set buf {}
1676 $r del x
1677 for {set i 0} {$i < 1000} {incr i} {
1678 set bin [randstring 0 10 $type]
1679 append buf $bin
1680 $r append x $bin
1681 }
1682 if {$buf != [$r get x]} {
1683 set err "Expected '$buf' found '[$r get x]'"
1684 break
1685 }
1686 }
1687 set _ $err
1688 } {}
1689
ed9b544e 1690 # Leave the user with a clean DB before to exit
eea4baf7 1691 test {FLUSHDB} {
1692 set aux {}
1693 $r select 9
1694 $r flushdb
1695 lappend aux [$r dbsize]
1696 $r select 10
1697 $r flushdb
1698 lappend aux [$r dbsize]
1699 } {0 0}
ed9b544e 1700
c28b42ac 1701 test {Perform a final SAVE to leave a clean DB on disk} {
1702 $r save
1703 } {OK}
1704
17511391 1705 catch {
1706 if {[string match {*Darwin*} [exec uname -a]]} {
1707 test {Check for memory leaks} {
1708 exec leaks redis-server
1709 } {*0 leaks*}
1710 }
1711 }
1712
ed9b544e 1713 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
1714 if {$::failed > 0} {
1715 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
1716 }
ed9b544e 1717}
1718
5a6948fb 1719proc stress {} {
43c9dc7b 1720 set r [redis]
eea4baf7 1721 $r select 9
1722 $r flushdb
5a6948fb 1723 while 1 {
1724 set randkey [expr int(rand()*10000)]
1725 set randval [expr int(rand()*10000)]
1726 set randidx0 [expr int(rand()*10)]
1727 set randidx1 [expr int(rand()*10)]
12f9d551 1728 set cmd [expr int(rand()*20)]
43c9dc7b 1729 catch {
1730 if {$cmd == 0} {$r set $randkey $randval}
1731 if {$cmd == 1} {$r get $randkey}
1732 if {$cmd == 2} {$r incr $randkey}
1733 if {$cmd == 3} {$r lpush $randkey $randval}
1734 if {$cmd == 4} {$r rpop $randkey}
1735 if {$cmd == 5} {$r del $randkey}
12f9d551 1736 if {$cmd == 6} {$r llen $randkey}
1737 if {$cmd == 7} {$r lrange $randkey $randidx0 $randidx1}
1738 if {$cmd == 8} {$r ltrim $randkey $randidx0 $randidx1}
1739 if {$cmd == 9} {$r lindex $randkey $randidx0}
1740 if {$cmd == 10} {$r lset $randkey $randidx0 $randval}
1741 if {$cmd == 11} {$r sadd $randkey $randval}
1742 if {$cmd == 12} {$r srem $randkey $randval}
1743 if {$cmd == 13} {$r smove $randkey $randval}
1744 if {$cmd == 14} {$r scard $randkey}
1745 if {$cmd == 15} {$r expire $randkey [expr $randval%60]}
43c9dc7b 1746 }
5a6948fb 1747 flush stdout
1748 }
eea4baf7 1749 $r flushdb
43c9dc7b 1750 $r close
5a6948fb 1751}
1752
fc77604c 1753# Set a few configuration defaults
1754set ::host 127.0.0.1
1755set ::port 6379
1756set ::stress 0
1757set ::flush 0
1758set ::first 0
1759set ::last 1000000
1760
1761# Parse arguments
1762for {set j 0} {$j < [llength $argv]} {incr j} {
1763 set opt [lindex $argv $j]
1764 set arg [lindex $argv [expr $j+1]]
1765 set lastarg [expr {$arg eq {}}]
1766 if {$opt eq {-h} && !$lastarg} {
1767 set ::host $arg
1768 incr j
1769 } elseif {$opt eq {-p} && !$lastarg} {
1770 set ::port $arg
1771 incr j
1772 } elseif {$opt eq {-stress}} {
1773 set ::stress 1
1774 } elseif {$opt eq {--flush}} {
1775 set ::flush 1
1776 } elseif {$opt eq {--first} && !$lastarg} {
1777 set ::first $arg
1778 incr j
1779 } elseif {$opt eq {--last} && !$lastarg} {
1780 set ::last $arg
1781 incr j
1782 } else {
7c49733c 1783 puts "Wrong argument: $opt"
fc77604c 1784 exit 1
1785 }
1786}
1787
eea4baf7 1788# Before to run the test check if DB 9 and DB 10 are empty
1789set r [redis]
fc77604c 1790
1791if {$::flush} {
1792 $r flushall
1793}
1794
eea4baf7 1795$r select 9
1796set db9size [$r dbsize]
1797$r select 10
1798set db10size [$r dbsize]
1799if {$db9size != 0 || $db10size != 0} {
1800 puts "Can't run the tests against DB 9 and 10: DBs are not empty."
1801 exit 1
1802}
1803$r close
1804unset r
1805unset db9size
1806unset db10size
1807
fc77604c 1808if {$::stress} {
5a6948fb 1809 stress
ed9b544e 1810} else {
fc77604c 1811 main $::host $::port
ed9b544e 1812}