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