]> git.saurik.com Git - redis.git/blob - test-redis.tcl
Merged Pietern patch for VM key args helper function. Fixed an obvious bug in the...
[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 {ZREVRANK basics} {
1208 list [$r zrevrank zranktmp x] [$r zrevrank zranktmp y] [$r zrevrank zranktmp z]
1209 } {2 1 0}
1210
1211 test {ZRANK - after deletion} {
1212 $r zrem zranktmp y
1213 list [$r zrank zranktmp x] [$r zrank zranktmp z]
1214 } {0 1}
1215
1216 test {ZSCORE} {
1217 set aux {}
1218 set err {}
1219 for {set i 0} {$i < 1000} {incr i} {
1220 set score [expr rand()]
1221 lappend aux $score
1222 $r zadd zscoretest $score $i
1223 }
1224 for {set i 0} {$i < 1000} {incr i} {
1225 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
1226 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
1227 break
1228 }
1229 }
1230 set _ $err
1231 } {}
1232
1233 test {ZSCORE after a DEBUG RELOAD} {
1234 set aux {}
1235 set err {}
1236 $r del zscoretest
1237 for {set i 0} {$i < 1000} {incr i} {
1238 set score [expr rand()]
1239 lappend aux $score
1240 $r zadd zscoretest $score $i
1241 }
1242 $r debug reload
1243 for {set i 0} {$i < 1000} {incr i} {
1244 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
1245 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
1246 break
1247 }
1248 }
1249 set _ $err
1250 } {}
1251
1252 test {ZRANGE and ZREVRANGE basics} {
1253 list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1] \
1254 [$r zrange ztmp 1 -1] [$r zrevrange ztmp 1 -1]
1255 } {{y x z} {z x y} {x z} {x y}}
1256
1257 test {ZRANGE WITHSCORES} {
1258 $r zrange ztmp 0 -1 withscores
1259 } {y 1 x 10 z 30}
1260
1261 test {ZSETs stress tester - sorting is working well?} {
1262 set delta 0
1263 for {set test 0} {$test < 2} {incr test} {
1264 unset -nocomplain auxarray
1265 array set auxarray {}
1266 set auxlist {}
1267 $r del myzset
1268 for {set i 0} {$i < 1000} {incr i} {
1269 if {$test == 0} {
1270 set score [expr rand()]
1271 } else {
1272 set score [expr int(rand()*10)]
1273 }
1274 set auxarray($i) $score
1275 $r zadd myzset $score $i
1276 # Random update
1277 if {[expr rand()] < .2} {
1278 set j [expr int(rand()*1000)]
1279 if {$test == 0} {
1280 set score [expr rand()]
1281 } else {
1282 set score [expr int(rand()*10)]
1283 }
1284 set auxarray($j) $score
1285 $r zadd myzset $score $j
1286 }
1287 }
1288 foreach {item score} [array get auxarray] {
1289 lappend auxlist [list $score $item]
1290 }
1291 set sorted [lsort -command zlistAlikeSort $auxlist]
1292 set auxlist {}
1293 foreach x $sorted {
1294 lappend auxlist [lindex $x 1]
1295 }
1296 set fromredis [$r zrange myzset 0 -1]
1297 set delta 0
1298 for {set i 0} {$i < [llength $fromredis]} {incr i} {
1299 if {[lindex $fromredis $i] != [lindex $auxlist $i]} {
1300 incr delta
1301 }
1302 }
1303 }
1304 format $delta
1305 } {0}
1306
1307 test {ZINCRBY - can create a new sorted set} {
1308 $r del zset
1309 $r zincrby zset 1 foo
1310 list [$r zrange zset 0 -1] [$r zscore zset foo]
1311 } {foo 1}
1312
1313 test {ZINCRBY - increment and decrement} {
1314 $r zincrby zset 2 foo
1315 $r zincrby zset 1 bar
1316 set v1 [$r zrange zset 0 -1]
1317 $r zincrby zset 10 bar
1318 $r zincrby zset -5 foo
1319 $r zincrby zset -5 bar
1320 set v2 [$r zrange zset 0 -1]
1321 list $v1 $v2 [$r zscore zset foo] [$r zscore zset bar]
1322 } {{bar foo} {foo bar} -2 6}
1323
1324 test {ZRANGEBYSCORE and ZCOUNT basics} {
1325 $r del zset
1326 $r zadd zset 1 a
1327 $r zadd zset 2 b
1328 $r zadd zset 3 c
1329 $r zadd zset 4 d
1330 $r zadd zset 5 e
1331 list [$r zrangebyscore zset 2 4] [$r zrangebyscore zset (2 (4] \
1332 [$r zcount zset 2 4] [$r zcount zset (2 (4]
1333 } {{b c d} c 3 1}
1334
1335 test {ZRANGEBYSCORE withscores} {
1336 $r del zset
1337 $r zadd zset 1 a
1338 $r zadd zset 2 b
1339 $r zadd zset 3 c
1340 $r zadd zset 4 d
1341 $r zadd zset 5 e
1342 $r zrangebyscore zset 2 4 withscores
1343 } {b 2 c 3 d 4}
1344
1345 test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
1346 set err {}
1347 $r del zset
1348 for {set i 0} {$i < 1000} {incr i} {
1349 $r zadd zset [expr rand()] $i
1350 }
1351 for {set i 0} {$i < 100} {incr i} {
1352 set min [expr rand()]
1353 set max [expr rand()]
1354 if {$min > $max} {
1355 set aux $min
1356 set min $max
1357 set max $aux
1358 }
1359 set low [$r zrangebyscore zset -inf $min]
1360 set ok [$r zrangebyscore zset $min $max]
1361 set high [$r zrangebyscore zset $max +inf]
1362 set lowx [$r zrangebyscore zset -inf ($min]
1363 set okx [$r zrangebyscore zset ($min ($max]
1364 set highx [$r zrangebyscore zset ($max +inf]
1365
1366 if {[$r zcount zset -inf $min] != [llength $low]} {
1367 append err "Error, len does not match zcount\n"
1368 }
1369 if {[$r zcount zset $min $max] != [llength $ok]} {
1370 append err "Error, len does not match zcount\n"
1371 }
1372 if {[$r zcount zset $max +inf] != [llength $high]} {
1373 append err "Error, len does not match zcount\n"
1374 }
1375 if {[$r zcount zset -inf ($min] != [llength $lowx]} {
1376 append err "Error, len does not match zcount\n"
1377 }
1378 if {[$r zcount zset ($min ($max] != [llength $okx]} {
1379 append err "Error, len does not match zcount\n"
1380 }
1381 if {[$r zcount zset ($max +inf] != [llength $highx]} {
1382 append err "Error, len does not match zcount\n"
1383 }
1384
1385 foreach x $low {
1386 set score [$r zscore zset $x]
1387 if {$score > $min} {
1388 append err "Error, score for $x is $score > $min\n"
1389 }
1390 }
1391 foreach x $lowx {
1392 set score [$r zscore zset $x]
1393 if {$score >= $min} {
1394 append err "Error, score for $x is $score >= $min\n"
1395 }
1396 }
1397 foreach x $ok {
1398 set score [$r zscore zset $x]
1399 if {$score < $min || $score > $max} {
1400 append err "Error, score for $x is $score outside $min-$max range\n"
1401 }
1402 }
1403 foreach x $okx {
1404 set score [$r zscore zset $x]
1405 if {$score <= $min || $score >= $max} {
1406 append err "Error, score for $x is $score outside $min-$max open range\n"
1407 }
1408 }
1409 foreach x $high {
1410 set score [$r zscore zset $x]
1411 if {$score < $max} {
1412 append err "Error, score for $x is $score < $max\n"
1413 }
1414 }
1415 foreach x $highx {
1416 set score [$r zscore zset $x]
1417 if {$score <= $max} {
1418 append err "Error, score for $x is $score <= $max\n"
1419 }
1420 }
1421 }
1422 set _ $err
1423 } {}
1424
1425 test {ZRANGEBYSCORE with LIMIT} {
1426 $r del zset
1427 $r zadd zset 1 a
1428 $r zadd zset 2 b
1429 $r zadd zset 3 c
1430 $r zadd zset 4 d
1431 $r zadd zset 5 e
1432 list \
1433 [$r zrangebyscore zset 0 10 LIMIT 0 2] \
1434 [$r zrangebyscore zset 0 10 LIMIT 2 3] \
1435 [$r zrangebyscore zset 0 10 LIMIT 2 10] \
1436 [$r zrangebyscore zset 0 10 LIMIT 20 10]
1437 } {{a b} {c d e} {c d e} {}}
1438
1439 test {ZRANGEBYSCORE with LIMIT and withscores} {
1440 $r del zset
1441 $r zadd zset 10 a
1442 $r zadd zset 20 b
1443 $r zadd zset 30 c
1444 $r zadd zset 40 d
1445 $r zadd zset 50 e
1446 $r zrangebyscore zset 20 50 LIMIT 2 3 withscores
1447 } {d 40 e 50}
1448
1449 test {ZREMRANGEBYSCORE basics} {
1450 $r del zset
1451 $r zadd zset 1 a
1452 $r zadd zset 2 b
1453 $r zadd zset 3 c
1454 $r zadd zset 4 d
1455 $r zadd zset 5 e
1456 list [$r zremrangebyscore zset 2 4] [$r zrange zset 0 -1]
1457 } {3 {a e}}
1458
1459 test {ZREMRANGEBYSCORE from -inf to +inf} {
1460 $r del zset
1461 $r zadd zset 1 a
1462 $r zadd zset 2 b
1463 $r zadd zset 3 c
1464 $r zadd zset 4 d
1465 $r zadd zset 5 e
1466 list [$r zremrangebyscore zset -inf +inf] [$r zrange zset 0 -1]
1467 } {5 {}}
1468
1469 test {ZREMRANGEBYRANK basics} {
1470 $r del zset
1471 $r zadd zset 1 a
1472 $r zadd zset 2 b
1473 $r zadd zset 3 c
1474 $r zadd zset 4 d
1475 $r zadd zset 5 e
1476 list [$r zremrangebyrank zset 1 3] [$r zrange zset 0 -1]
1477 } {3 {a e}}
1478
1479 test {ZUNION basics} {
1480 $r del zseta zsetb zsetc
1481 $r zadd zseta 1 a
1482 $r zadd zseta 2 b
1483 $r zadd zseta 3 c
1484 $r zadd zsetb 1 b
1485 $r zadd zsetb 2 c
1486 $r zadd zsetb 3 d
1487 list [$r zunion zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
1488 } {4 {a 1 b 3 d 3 c 5}}
1489
1490 test {ZUNION with weights} {
1491 list [$r zunion zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
1492 } {4 {a 2 b 7 d 9 c 12}}
1493
1494 test {ZUNION with AGGREGATE MIN} {
1495 list [$r zunion zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores]
1496 } {4 {a 1 b 1 c 2 d 3}}
1497
1498 test {ZUNION with AGGREGATE MAX} {
1499 list [$r zunion zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores]
1500 } {4 {a 1 b 2 c 3 d 3}}
1501
1502 test {ZINTER basics} {
1503 list [$r zinter zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
1504 } {2 {b 3 c 5}}
1505
1506 test {ZINTER with weights} {
1507 list [$r zinter zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
1508 } {2 {b 7 c 12}}
1509
1510 test {ZINTER with AGGREGATE MIN} {
1511 list [$r zinter zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores]
1512 } {2 {b 1 c 2}}
1513
1514 test {ZINTER with AGGREGATE MAX} {
1515 list [$r zinter zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores]
1516 } {2 {b 2 c 3}}
1517
1518 test {SORT against sorted sets} {
1519 $r del zset
1520 $r zadd zset 1 a
1521 $r zadd zset 5 b
1522 $r zadd zset 2 c
1523 $r zadd zset 10 d
1524 $r zadd zset 3 e
1525 $r sort zset alpha desc
1526 } {e d c b a}
1527
1528 test {Sorted sets +inf and -inf handling} {
1529 $r del zset
1530 $r zadd zset -100 a
1531 $r zadd zset 200 b
1532 $r zadd zset -300 c
1533 $r zadd zset 1000000 d
1534 $r zadd zset +inf max
1535 $r zadd zset -inf min
1536 $r zrange zset 0 -1
1537 } {min c a b d max}
1538
1539 test {HSET/HLEN - Small hash creation} {
1540 array set smallhash {}
1541 for {set i 0} {$i < 8} {incr i} {
1542 set key [randstring 0 8 alpha]
1543 set val [randstring 0 8 alpha]
1544 if {[info exists smallhash($key)]} {
1545 incr i -1
1546 continue
1547 }
1548 $r hset smallhash $key $val
1549 set smallhash($key) $val
1550 }
1551 list [$r hlen smallhash]
1552 } {8}
1553
1554 test {Is the small hash encoded with a zipmap?} {
1555 $r debug object smallhash
1556 } {*zipmap*}
1557
1558 test {HSET/HLEN - Big hash creation} {
1559 array set bighash {}
1560 for {set i 0} {$i < 1024} {incr i} {
1561 set key [randstring 0 8 alpha]
1562 set val [randstring 0 8 alpha]
1563 if {[info exists bighash($key)]} {
1564 incr i -1
1565 continue
1566 }
1567 $r hset bighash $key $val
1568 set bighash($key) $val
1569 }
1570 list [$r hlen bighash]
1571 } {1024}
1572
1573 test {Is the big hash encoded with a zipmap?} {
1574 $r debug object bighash
1575 } {*hashtable*}
1576
1577 test {HGET against the small hash} {
1578 set err {}
1579 foreach k [array names smallhash *] {
1580 if {$smallhash($k) ne [$r hget smallhash $k]} {
1581 set err "$smallhash($k) != [$r hget smallhash $k]"
1582 break
1583 }
1584 }
1585 set _ $err
1586 } {}
1587
1588 test {HGET against the big hash} {
1589 set err {}
1590 foreach k [array names bighash *] {
1591 if {$bighash($k) ne [$r hget bighash $k]} {
1592 set err "$bighash($k) != [$r hget bighash $k]"
1593 break
1594 }
1595 }
1596 set _ $err
1597 } {}
1598
1599 test {HSET in update and insert mode} {
1600 set rv {}
1601 set k [lindex [array names smallhash *] 0]
1602 lappend rv [$r hset smallhash $k newval1]
1603 set smallhash($k) newval1
1604 lappend rv [$r hget smallhash $k]
1605 lappend rv [$r hset smallhash __foobar123__ newval]
1606 set k [lindex [array names bighash *] 0]
1607 lappend rv [$r hset bighash $k newval2]
1608 set bighash($k) newval2
1609 lappend rv [$r hget bighash $k]
1610 lappend rv [$r hset bighash __foobar123__ newval]
1611 lappend rv [$r hdel smallhash __foobar123__]
1612 lappend rv [$r hdel bighash __foobar123__]
1613 set _ $rv
1614 } {0 newval1 1 0 newval2 1 1 1}
1615
1616 test {HGET against non existing key} {
1617 set rv {}
1618 lappend rv [$r hget smallhash __123123123__]
1619 lappend rv [$r hget bighash __123123123__]
1620 set _ $rv
1621 } {{} {}}
1622
1623 test {HKEYS - small hash} {
1624 lsort [$r hkeys smallhash]
1625 } [lsort [array names smallhash *]]
1626
1627 test {HKEYS - big hash} {
1628 lsort [$r hkeys bighash]
1629 } [lsort [array names bighash *]]
1630
1631 test {HVALS - small hash} {
1632 set vals {}
1633 foreach {k v} [array get smallhash] {
1634 lappend vals $v
1635 }
1636 set _ [lsort $vals]
1637 } [lsort [$r hvals smallhash]]
1638
1639 test {HVALS - big hash} {
1640 set vals {}
1641 foreach {k v} [array get bighash] {
1642 lappend vals $v
1643 }
1644 set _ [lsort $vals]
1645 } [lsort [$r hvals bighash]]
1646
1647 test {HGETALL - small hash} {
1648 lsort [$r hgetall smallhash]
1649 } [lsort [array get smallhash]]
1650
1651 test {HGETALL - big hash} {
1652 lsort [$r hgetall bighash]
1653 } [lsort [array get bighash]]
1654
1655 test {HDEL and return value} {
1656 set rv {}
1657 lappend rv [$r hdel smallhash nokey]
1658 lappend rv [$r hdel bighash nokey]
1659 set k [lindex [array names smallhash *] 0]
1660 lappend rv [$r hdel smallhash $k]
1661 lappend rv [$r hdel smallhash $k]
1662 lappend rv [$r hget smallhash $k]
1663 unset smallhash($k)
1664 set k [lindex [array names bighash *] 0]
1665 lappend rv [$r hdel bighash $k]
1666 lappend rv [$r hdel bighash $k]
1667 lappend rv [$r hget bighash $k]
1668 unset bighash($k)
1669 set _ $rv
1670 } {0 0 1 0 {} 1 0 {}}
1671
1672 test {HEXISTS} {
1673 set rv {}
1674 set k [lindex [array names smallhash *] 0]
1675 lappend rv [$r hexists smallhash $k]
1676 lappend rv [$r hexists smallhash nokey]
1677 set k [lindex [array names bighash *] 0]
1678 lappend rv [$r hexists bighash $k]
1679 lappend rv [$r hexists bighash nokey]
1680 } {1 0 1 0}
1681
1682 test {Is a zipmap encoded Hash promoted on big payload?} {
1683 $r hset smallhash foo [string repeat a 1024]
1684 $r debug object smallhash
1685 } {*hashtable*}
1686
1687 # TODO:
1688 # Randomized test, small and big
1689 # .rdb / AOF consistency test should include hashes
1690
1691 test {EXPIRE - don't set timeouts multiple times} {
1692 $r set x foobar
1693 set v1 [$r expire x 5]
1694 set v2 [$r ttl x]
1695 set v3 [$r expire x 10]
1696 set v4 [$r ttl x]
1697 list $v1 $v2 $v3 $v4
1698 } {1 5 0 5}
1699
1700 test {EXPIRE - It should be still possible to read 'x'} {
1701 $r get x
1702 } {foobar}
1703
1704 test {EXPIRE - After 6 seconds the key should no longer be here} {
1705 after 6000
1706 list [$r get x] [$r exists x]
1707 } {{} 0}
1708
1709 test {EXPIRE - Delete on write policy} {
1710 $r del x
1711 $r lpush x foo
1712 $r expire x 1000
1713 $r lpush x bar
1714 $r lrange x 0 -1
1715 } {bar}
1716
1717 test {EXPIREAT - Check for EXPIRE alike behavior} {
1718 $r del x
1719 $r set x foo
1720 $r expireat x [expr [clock seconds]+15]
1721 $r ttl x
1722 } {1[345]}
1723
1724 test {ZSETs skiplist implementation backlink consistency test} {
1725 set diff 0
1726 set elements 10000
1727 for {set j 0} {$j < $elements} {incr j} {
1728 $r zadd myzset [expr rand()] "Element-$j"
1729 $r zrem myzset "Element-[expr int(rand()*$elements)]"
1730 }
1731 set l1 [$r zrange myzset 0 -1]
1732 set l2 [$r zrevrange myzset 0 -1]
1733 for {set j 0} {$j < [llength $l1]} {incr j} {
1734 if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
1735 incr diff
1736 }
1737 }
1738 format $diff
1739 } {0}
1740
1741 test {ZSETs ZRANK augmented skip list stress testing} {
1742 set err {}
1743 $r del myzset
1744 for {set k 0} {$k < 10000} {incr k} {
1745 set i [expr {$k%1000}]
1746 if {[expr rand()] < .2} {
1747 $r zrem myzset $i
1748 } else {
1749 set score [expr rand()]
1750 $r zadd myzset $score $i
1751 }
1752 set card [$r zcard myzset]
1753 if {$card > 0} {
1754 set index [randomInt $card]
1755 set ele [lindex [$r zrange myzset $index $index] 0]
1756 set rank [$r zrank myzset $ele]
1757 if {$rank != $index} {
1758 set err "$ele RANK is wrong! ($rank != $index)"
1759 break
1760 }
1761 }
1762 }
1763 set _ $err
1764 } {}
1765
1766 foreach fuzztype {binary alpha compr} {
1767 test "FUZZ stresser with data model $fuzztype" {
1768 set err 0
1769 for {set i 0} {$i < 10000} {incr i} {
1770 set fuzz [randstring 0 512 $fuzztype]
1771 $r set foo $fuzz
1772 set got [$r get foo]
1773 if {$got ne $fuzz} {
1774 set err [list $fuzz $got]
1775 break
1776 }
1777 }
1778 set _ $err
1779 } {0}
1780 }
1781
1782 test {BGSAVE} {
1783 waitForBgsave $r
1784 $r flushdb
1785 $r save
1786 $r set x 10
1787 $r bgsave
1788 waitForBgsave $r
1789 $r debug reload
1790 $r get x
1791 } {10}
1792
1793 test {Handle an empty query well} {
1794 set fd [$r channel]
1795 puts -nonewline $fd "\r\n"
1796 flush $fd
1797 $r ping
1798 } {PONG}
1799
1800 test {Negative multi bulk command does not create problems} {
1801 set fd [$r channel]
1802 puts -nonewline $fd "*-10\r\n"
1803 flush $fd
1804 $r ping
1805 } {PONG}
1806
1807 test {Negative multi bulk payload} {
1808 set fd [$r channel]
1809 puts -nonewline $fd "SET x -10\r\n"
1810 flush $fd
1811 gets $fd
1812 } {*invalid bulk*}
1813
1814 test {Too big bulk payload} {
1815 set fd [$r channel]
1816 puts -nonewline $fd "SET x 2000000000\r\n"
1817 flush $fd
1818 gets $fd
1819 } {*invalid bulk*count*}
1820
1821 test {Multi bulk request not followed by bulk args} {
1822 set fd [$r channel]
1823 puts -nonewline $fd "*1\r\nfoo\r\n"
1824 flush $fd
1825 gets $fd
1826 } {*protocol error*}
1827
1828 test {Generic wrong number of args} {
1829 catch {$r ping x y z} err
1830 set _ $err
1831 } {*wrong*arguments*ping*}
1832
1833 test {SELECT an out of range DB} {
1834 catch {$r select 1000000} err
1835 set _ $err
1836 } {*invalid*}
1837
1838 if {![catch {package require sha1}]} {
1839 test {Check consistency of different data types after a reload} {
1840 $r flushdb
1841 createComplexDataset $r 10000
1842 set sha1 [datasetDigest $r]
1843 $r debug reload
1844 set sha1_after [datasetDigest $r]
1845 expr {$sha1 eq $sha1_after}
1846 } {1}
1847
1848 test {Same dataset digest if saving/reloading as AOF?} {
1849 $r bgrewriteaof
1850 waitForBgrewriteaof $r
1851 $r debug loadaof
1852 set sha1_after [datasetDigest $r]
1853 expr {$sha1 eq $sha1_after}
1854 } {1}
1855 }
1856
1857 test {EXPIRES after a reload (snapshot + append only file)} {
1858 $r flushdb
1859 $r set x 10
1860 $r expire x 1000
1861 $r save
1862 $r debug reload
1863 set ttl [$r ttl x]
1864 set e1 [expr {$ttl > 900 && $ttl <= 1000}]
1865 $r bgrewriteaof
1866 waitForBgrewriteaof $r
1867 set ttl [$r ttl x]
1868 set e2 [expr {$ttl > 900 && $ttl <= 1000}]
1869 list $e1 $e2
1870 } {1 1}
1871
1872 test {PIPELINING stresser (also a regression for the old epoll bug)} {
1873 set fd2 [socket 127.0.0.1 6379]
1874 fconfigure $fd2 -encoding binary -translation binary
1875 puts -nonewline $fd2 "SELECT 9\r\n"
1876 flush $fd2
1877 gets $fd2
1878
1879 for {set i 0} {$i < 100000} {incr i} {
1880 set q {}
1881 set val "0000${i}0000"
1882 append q "SET key:$i [string length $val]\r\n$val\r\n"
1883 puts -nonewline $fd2 $q
1884 set q {}
1885 append q "GET key:$i\r\n"
1886 puts -nonewline $fd2 $q
1887 }
1888 flush $fd2
1889
1890 for {set i 0} {$i < 100000} {incr i} {
1891 gets $fd2 line
1892 gets $fd2 count
1893 set count [string range $count 1 end]
1894 set val [read $fd2 $count]
1895 read $fd2 2
1896 }
1897 close $fd2
1898 set _ 1
1899 } {1}
1900
1901 test {MUTLI / EXEC basics} {
1902 $r del mylist
1903 $r rpush mylist a
1904 $r rpush mylist b
1905 $r rpush mylist c
1906 $r multi
1907 set v1 [$r lrange mylist 0 -1]
1908 set v2 [$r ping]
1909 set v3 [$r exec]
1910 list $v1 $v2 $v3
1911 } {QUEUED QUEUED {{a b c} PONG}}
1912
1913 test {DISCARD} {
1914 $r del mylist
1915 $r rpush mylist a
1916 $r rpush mylist b
1917 $r rpush mylist c
1918 $r multi
1919 set v1 [$r del mylist]
1920 set v2 [$r discard]
1921 set v3 [$r lrange mylist 0 -1]
1922 list $v1 $v2 $v3
1923 } {QUEUED OK {a b c}}
1924
1925 test {APPEND basics} {
1926 list [$r append foo bar] [$r get foo] \
1927 [$r append foo 100] [$r get foo]
1928 } {3 bar 6 bar100}
1929
1930 test {APPEND fuzzing} {
1931 set err {}
1932 foreach type {binary alpha compr} {
1933 set buf {}
1934 $r del x
1935 for {set i 0} {$i < 1000} {incr i} {
1936 set bin [randstring 0 10 $type]
1937 append buf $bin
1938 $r append x $bin
1939 }
1940 if {$buf != [$r get x]} {
1941 set err "Expected '$buf' found '[$r get x]'"
1942 break
1943 }
1944 }
1945 set _ $err
1946 } {}
1947
1948 # Leave the user with a clean DB before to exit
1949 test {FLUSHDB} {
1950 set aux {}
1951 $r select 9
1952 $r flushdb
1953 lappend aux [$r dbsize]
1954 $r select 10
1955 $r flushdb
1956 lappend aux [$r dbsize]
1957 } {0 0}
1958
1959 test {Perform a final SAVE to leave a clean DB on disk} {
1960 $r save
1961 } {OK}
1962
1963 catch {
1964 if {[string match {*Darwin*} [exec uname -a]]} {
1965 test {Check for memory leaks} {
1966 exec leaks redis-server
1967 } {*0 leaks*}
1968 }
1969 }
1970
1971 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
1972 if {$::failed > 0} {
1973 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
1974 }
1975 }
1976
1977 proc stress {} {
1978 set r [redis]
1979 $r select 9
1980 $r flushdb
1981 while 1 {
1982 set randkey [expr int(rand()*10000)]
1983 set randval [expr int(rand()*10000)]
1984 set randidx0 [expr int(rand()*10)]
1985 set randidx1 [expr int(rand()*10)]
1986 set cmd [expr int(rand()*20)]
1987 catch {
1988 if {$cmd == 0} {$r set $randkey $randval}
1989 if {$cmd == 1} {$r get $randkey}
1990 if {$cmd == 2} {$r incr $randkey}
1991 if {$cmd == 3} {$r lpush $randkey $randval}
1992 if {$cmd == 4} {$r rpop $randkey}
1993 if {$cmd == 5} {$r del $randkey}
1994 if {$cmd == 6} {$r llen $randkey}
1995 if {$cmd == 7} {$r lrange $randkey $randidx0 $randidx1}
1996 if {$cmd == 8} {$r ltrim $randkey $randidx0 $randidx1}
1997 if {$cmd == 9} {$r lindex $randkey $randidx0}
1998 if {$cmd == 10} {$r lset $randkey $randidx0 $randval}
1999 if {$cmd == 11} {$r sadd $randkey $randval}
2000 if {$cmd == 12} {$r srem $randkey $randval}
2001 if {$cmd == 13} {$r smove $randkey $randval}
2002 if {$cmd == 14} {$r scard $randkey}
2003 if {$cmd == 15} {$r expire $randkey [expr $randval%60]}
2004 }
2005 flush stdout
2006 }
2007 $r flushdb
2008 $r close
2009 }
2010
2011 # Set a few configuration defaults
2012 set ::host 127.0.0.1
2013 set ::port 6379
2014 set ::stress 0
2015 set ::flush 0
2016 set ::first 0
2017 set ::last 1000000
2018
2019 # Parse arguments
2020 for {set j 0} {$j < [llength $argv]} {incr j} {
2021 set opt [lindex $argv $j]
2022 set arg [lindex $argv [expr $j+1]]
2023 set lastarg [expr {$arg eq {}}]
2024 if {$opt eq {-h} && !$lastarg} {
2025 set ::host $arg
2026 incr j
2027 } elseif {$opt eq {-p} && !$lastarg} {
2028 set ::port $arg
2029 incr j
2030 } elseif {$opt eq {-stress}} {
2031 set ::stress 1
2032 } elseif {$opt eq {--flush}} {
2033 set ::flush 1
2034 } elseif {$opt eq {--first} && !$lastarg} {
2035 set ::first $arg
2036 incr j
2037 } elseif {$opt eq {--last} && !$lastarg} {
2038 set ::last $arg
2039 incr j
2040 } else {
2041 puts "Wrong argument: $opt"
2042 exit 1
2043 }
2044 }
2045
2046 # Before to run the test check if DB 9 and DB 10 are empty
2047 set r [redis]
2048
2049 if {$::flush} {
2050 $r flushall
2051 }
2052
2053 $r select 9
2054 set db9size [$r dbsize]
2055 $r select 10
2056 set db10size [$r dbsize]
2057 if {$db9size != 0 || $db10size != 0} {
2058 puts "Can't run the tests against DB 9 and 10: DBs are not empty."
2059 exit 1
2060 }
2061 $r close
2062 unset r
2063 unset db9size
2064 unset db10size
2065
2066 if {$::stress} {
2067 stress
2068 } else {
2069 main $::host $::port
2070 }