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