]> git.saurik.com Git - redis.git/blob - test-redis.tcl
one more fix for endianess detection
[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 if {$::traceleaks} {
27 if {![string match {*0 leaks*} [exec leaks redis-server]]} {
28 puts "--------- Test $::testnum LEAKED! --------"
29 exit 1
30 }
31 }
32 }
33
34 proc randstring {min max {type binary}} {
35 set len [expr {$min+int(rand()*($max-$min+1))}]
36 set output {}
37 if {$type eq {binary}} {
38 set minval 0
39 set maxval 255
40 } elseif {$type eq {alpha}} {
41 set minval 48
42 set maxval 122
43 } elseif {$type eq {compr}} {
44 set minval 48
45 set maxval 52
46 }
47 while {$len} {
48 append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]]
49 incr len -1
50 }
51 return $output
52 }
53
54 # Useful for some test
55 proc zlistAlikeSort {a b} {
56 if {[lindex $a 0] > [lindex $b 0]} {return 1}
57 if {[lindex $a 0] < [lindex $b 0]} {return -1}
58 string compare [lindex $a 1] [lindex $b 1]
59 }
60
61 proc waitForBgsave r {
62 while 1 {
63 set i [$r info]
64 if {[string match {*bgsave_in_progress:1*} $i]} {
65 puts -nonewline "\nWaiting for background save to finish... "
66 flush stdout
67 after 1000
68 } else {
69 break
70 }
71 }
72 }
73
74 proc waitForBgrewriteaof r {
75 while 1 {
76 set i [$r info]
77 if {[string match {*bgrewriteaof_in_progress:1*} $i]} {
78 puts -nonewline "\nWaiting for background AOF rewrite to finish... "
79 flush stdout
80 after 1000
81 } else {
82 break
83 }
84 }
85 }
86
87 proc randomInt {max} {
88 expr {int(rand()*$max)}
89 }
90
91 proc randpath args {
92 set path [expr {int(rand()*[llength $args])}]
93 uplevel 1 [lindex $args $path]
94 }
95
96 proc randomValue {} {
97 randpath {
98 # Small enough to likely collide
99 randomInt 1000
100 } {
101 # 32 bit compressible signed/unsigned
102 randpath {randomInt 2000000000} {randomInt 4000000000}
103 } {
104 # 64 bit
105 randpath {randomInt 1000000000000}
106 } {
107 # Random string
108 randpath {randstring 0 256 alpha} \
109 {randstring 0 256 compr} \
110 {randstring 0 256 binary}
111 }
112 }
113
114 proc randomKey {} {
115 randpath {
116 # Small enough to likely collide
117 randomInt 1000
118 } {
119 # 32 bit compressible signed/unsigned
120 randpath {randomInt 2000000000} {randomInt 4000000000}
121 } {
122 # 64 bit
123 randpath {randomInt 1000000000000}
124 } {
125 # Random string
126 randpath {randstring 1 256 alpha} \
127 {randstring 1 256 compr}
128 }
129 }
130
131 proc createComplexDataset {r ops} {
132 for {set j 0} {$j < $ops} {incr j} {
133 set k [randomKey]
134 set f [randomValue]
135 set v [randomValue]
136 randpath {
137 set d [expr {rand()}]
138 } {
139 set d [expr {rand()}]
140 } {
141 set d [expr {rand()}]
142 } {
143 set d [expr {rand()}]
144 } {
145 set d [expr {rand()}]
146 } {
147 randpath {set d +inf} {set d -inf}
148 }
149 set t [$r type $k]
150
151 if {$t eq {none}} {
152 randpath {
153 $r set $k $v
154 } {
155 $r lpush $k $v
156 } {
157 $r sadd $k $v
158 } {
159 $r zadd $k $d $v
160 } {
161 $r hset $k $f $v
162 }
163 set t [$r type $k]
164 }
165
166 switch $t {
167 {string} {
168 # Nothing to do
169 }
170 {list} {
171 randpath {$r lpush $k $v} \
172 {$r rpush $k $v} \
173 {$r lrem $k 0 $v} \
174 {$r rpop $k} \
175 {$r lpop $k}
176 }
177 {set} {
178 randpath {$r sadd $k $v} \
179 {$r srem $k $v}
180 }
181 {zset} {
182 randpath {$r zadd $k $d $v} \
183 {$r zrem $k $v}
184 }
185 {hash} {
186 randpath {$r hset $k $f $v} \
187 {$r hdel $k $f}
188 }
189 }
190 }
191 }
192
193 proc datasetDigest r {
194 $r debug digest
195 }
196
197 proc main {} {
198 set r [redis $::host $::port]
199 $r select 9
200 set err ""
201 set res ""
202
203 # The following AUTH test should be enabled only when requirepass
204 # <PASSWORD> is set in redis.conf and redis-server was started with
205 # redis.conf as the first argument.
206
207 #test {AUTH with requirepass in redis.conf} {
208 # $r auth foobared
209 #} {OK}
210
211 test {DEL all keys to start with a clean DB} {
212 foreach key [$r keys *] {$r del $key}
213 $r dbsize
214 } {0}
215
216 test {SET and GET an item} {
217 $r set x foobar
218 $r get x
219 } {foobar}
220
221 test {SET and GET an empty item} {
222 $r set x {}
223 $r get x
224 } {}
225
226 test {DEL against a single item} {
227 $r del x
228 $r get x
229 } {}
230
231 test {Vararg DEL} {
232 $r set foo1 a
233 $r set foo2 b
234 $r set foo3 c
235 list [$r del foo1 foo2 foo3 foo4] [$r mget foo1 foo2 foo3]
236 } {3 {{} {} {}}}
237
238 test {KEYS with pattern} {
239 foreach key {key_x key_y key_z foo_a foo_b foo_c} {
240 $r set $key hello
241 }
242 lsort [$r keys foo*]
243 } {foo_a foo_b foo_c}
244
245 test {KEYS to get all keys} {
246 lsort [$r keys *]
247 } {foo_a foo_b foo_c key_x key_y key_z}
248
249 test {DBSIZE} {
250 $r dbsize
251 } {6}
252
253 test {DEL all keys} {
254 foreach key [$r keys *] {$r del $key}
255 $r dbsize
256 } {0}
257
258 test {Very big payload in GET/SET} {
259 set buf [string repeat "abcd" 1000000]
260 $r set foo $buf
261 $r get foo
262 } [string repeat "abcd" 1000000]
263
264 test {Very big payload random access} {
265 set err {}
266 array set payload {}
267 for {set j 0} {$j < 100} {incr j} {
268 set size [expr 1+[randomInt 100000]]
269 set buf [string repeat "pl-$j" $size]
270 set payload($j) $buf
271 $r set bigpayload_$j $buf
272 }
273 for {set j 0} {$j < 1000} {incr j} {
274 set index [randomInt 100]
275 set buf [$r get bigpayload_$index]
276 if {$buf != $payload($index)} {
277 set err "Values differ: I set '$payload($index)' but I read back '$buf'"
278 break
279 }
280 }
281 unset payload
282 set _ $err
283 } {}
284
285 test {SET 10000 numeric keys and access all them in reverse order} {
286 set err {}
287 for {set x 0} {$x < 10000} {incr x} {
288 $r set $x $x
289 }
290 set sum 0
291 for {set x 9999} {$x >= 0} {incr x -1} {
292 set val [$r get $x]
293 if {$val ne $x} {
294 set err "Eleemnt at position $x is $val instead of $x"
295 break
296 }
297 }
298 set _ $err
299 } {}
300
301 test {DBSIZE should be 10101 now} {
302 $r dbsize
303 } {10101}
304
305 test {INCR against non existing key} {
306 set res {}
307 append res [$r incr novar]
308 append res [$r get novar]
309 } {11}
310
311 test {INCR against key created by incr itself} {
312 $r incr novar
313 } {2}
314
315 test {INCR against key originally set with SET} {
316 $r set novar 100
317 $r incr novar
318 } {101}
319
320 test {INCR over 32bit value} {
321 $r set novar 17179869184
322 $r incr novar
323 } {17179869185}
324
325 test {INCRBY over 32bit value with over 32bit increment} {
326 $r set novar 17179869184
327 $r incrby novar 17179869184
328 } {34359738368}
329
330 test {INCR fails against key with spaces (no integer encoded)} {
331 $r set novar " 11 "
332 catch {$r incr novar} err
333 format $err
334 } {ERR*}
335
336 test {INCR fails against a key holding a list} {
337 $r rpush mylist 1
338 catch {$r incr mylist} err
339 $r rpop mylist
340 format $err
341 } {ERR*}
342
343 test {DECRBY over 32bit value with over 32bit increment, negative res} {
344 $r set novar 17179869184
345 $r decrby novar 17179869185
346 } {-1}
347
348 test {SETNX target key missing} {
349 $r setnx novar2 foobared
350 $r get novar2
351 } {foobared}
352
353 test {SETNX target key exists} {
354 $r setnx novar2 blabla
355 $r get novar2
356 } {foobared}
357
358 test {SETNX will overwrite EXPIREing key} {
359 $r set x 10
360 $r expire x 10000
361 $r setnx x 20
362 $r get x
363 } {20}
364
365 test {EXISTS} {
366 set res {}
367 $r set newkey test
368 append res [$r exists newkey]
369 $r del newkey
370 append res [$r exists newkey]
371 } {10}
372
373 test {Zero length value in key. SET/GET/EXISTS} {
374 $r set emptykey {}
375 set res [$r get emptykey]
376 append res [$r exists emptykey]
377 $r del emptykey
378 append res [$r exists emptykey]
379 } {10}
380
381 test {Commands pipelining} {
382 set fd [$r channel]
383 puts -nonewline $fd "SET k1 4\r\nxyzk\r\nGET k1\r\nPING\r\n"
384 flush $fd
385 set res {}
386 append res [string match OK* [::redis::redis_read_reply $fd]]
387 append res [::redis::redis_read_reply $fd]
388 append res [string match PONG* [::redis::redis_read_reply $fd]]
389 format $res
390 } {1xyzk1}
391
392 test {Non existing command} {
393 catch {$r foobaredcommand} err
394 string match ERR* $err
395 } {1}
396
397 test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
398 set res [$r lpush mylist a]
399 append res [$r lpush mylist b]
400 append res [$r rpush mylist c]
401 append res [$r llen mylist]
402 append res [$r rpush anotherlist d]
403 append res [$r lpush anotherlist e]
404 append res [$r llen anotherlist]
405 append res [$r lindex mylist 0]
406 append res [$r lindex mylist 1]
407 append res [$r lindex mylist 2]
408 append res [$r lindex anotherlist 0]
409 append res [$r lindex anotherlist 1]
410 list $res [$r lindex mylist 100]
411 } {1233122baced {}}
412
413 test {DEL a list} {
414 $r del mylist
415 $r exists mylist
416 } {0}
417
418 test {Create a long list and check every single element with LINDEX} {
419 set ok 0
420 for {set i 0} {$i < 1000} {incr i} {
421 $r rpush mylist $i
422 }
423 for {set i 0} {$i < 1000} {incr i} {
424 if {[$r lindex mylist $i] eq $i} {incr ok}
425 if {[$r lindex mylist [expr (-$i)-1]] eq [expr 999-$i]} {
426 incr ok
427 }
428 }
429 format $ok
430 } {2000}
431
432 test {Test elements with LINDEX in random access} {
433 set ok 0
434 for {set i 0} {$i < 1000} {incr i} {
435 set rint [expr int(rand()*1000)]
436 if {[$r lindex mylist $rint] eq $rint} {incr ok}
437 if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
438 incr ok
439 }
440 }
441 format $ok
442 } {2000}
443
444 test {Check if the list is still ok after a DEBUG RELOAD} {
445 $r debug reload
446 set ok 0
447 for {set i 0} {$i < 1000} {incr i} {
448 set rint [expr int(rand()*1000)]
449 if {[$r lindex mylist $rint] eq $rint} {incr ok}
450 if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
451 incr ok
452 }
453 }
454 format $ok
455 } {2000}
456
457 test {LLEN against non-list value error} {
458 $r del mylist
459 $r set mylist foobar
460 catch {$r llen mylist} err
461 format $err
462 } {ERR*}
463
464 test {LLEN against non existing key} {
465 $r llen not-a-key
466 } {0}
467
468 test {LINDEX against non-list value error} {
469 catch {$r lindex mylist 0} err
470 format $err
471 } {ERR*}
472
473 test {LINDEX against non existing key} {
474 $r lindex not-a-key 10
475 } {}
476
477 test {LPUSH against non-list value error} {
478 catch {$r lpush mylist 0} err
479 format $err
480 } {ERR*}
481
482 test {RPUSH against non-list value error} {
483 catch {$r rpush mylist 0} err
484 format $err
485 } {ERR*}
486
487 test {RPOPLPUSH base case} {
488 $r del mylist
489 $r rpush mylist a
490 $r rpush mylist b
491 $r rpush mylist c
492 $r rpush mylist d
493 set v1 [$r rpoplpush mylist newlist]
494 set v2 [$r rpoplpush mylist newlist]
495 set l1 [$r lrange mylist 0 -1]
496 set l2 [$r lrange newlist 0 -1]
497 list $v1 $v2 $l1 $l2
498 } {d c {a b} {c d}}
499
500 test {RPOPLPUSH with the same list as src and dst} {
501 $r del mylist
502 $r rpush mylist a
503 $r rpush mylist b
504 $r rpush mylist c
505 set l1 [$r lrange mylist 0 -1]
506 set v [$r rpoplpush mylist mylist]
507 set l2 [$r lrange mylist 0 -1]
508 list $l1 $v $l2
509 } {{a b c} c {c a b}}
510
511 test {RPOPLPUSH target list already exists} {
512 $r del mylist
513 $r del newlist
514 $r rpush mylist a
515 $r rpush mylist b
516 $r rpush mylist c
517 $r rpush mylist d
518 $r rpush newlist x
519 set v1 [$r rpoplpush mylist newlist]
520 set v2 [$r rpoplpush mylist newlist]
521 set l1 [$r lrange mylist 0 -1]
522 set l2 [$r lrange newlist 0 -1]
523 list $v1 $v2 $l1 $l2
524 } {d c {a b} {c d x}}
525
526 test {RPOPLPUSH against non existing key} {
527 $r del mylist
528 $r del newlist
529 set v1 [$r rpoplpush mylist newlist]
530 list $v1 [$r exists mylist] [$r exists newlist]
531 } {{} 0 0}
532
533 test {RPOPLPUSH against non list src key} {
534 $r del mylist
535 $r del newlist
536 $r set mylist x
537 catch {$r rpoplpush mylist newlist} err
538 list [$r type mylist] [$r exists newlist] [string range $err 0 2]
539 } {string 0 ERR}
540
541 test {RPOPLPUSH against non list dst key} {
542 $r del mylist
543 $r del newlist
544 $r rpush mylist a
545 $r rpush mylist b
546 $r rpush mylist c
547 $r rpush mylist d
548 $r set newlist x
549 catch {$r rpoplpush mylist newlist} err
550 list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2]
551 } {{a b c d} string ERR}
552
553 test {RPOPLPUSH against non existing src key} {
554 $r del mylist
555 $r del newlist
556 $r rpoplpush mylist newlist
557 } {}
558
559 test {RENAME basic usage} {
560 $r set mykey hello
561 $r rename mykey mykey1
562 $r rename mykey1 mykey2
563 $r get mykey2
564 } {hello}
565
566 test {RENAME source key should no longer exist} {
567 $r exists mykey
568 } {0}
569
570 test {RENAME against already existing key} {
571 $r set mykey a
572 $r set mykey2 b
573 $r rename mykey2 mykey
574 set res [$r get mykey]
575 append res [$r exists mykey2]
576 } {b0}
577
578 test {RENAMENX basic usage} {
579 $r del mykey
580 $r del mykey2
581 $r set mykey foobar
582 $r renamenx mykey mykey2
583 set res [$r get mykey2]
584 append res [$r exists mykey]
585 } {foobar0}
586
587 test {RENAMENX against already existing key} {
588 $r set mykey foo
589 $r set mykey2 bar
590 $r renamenx mykey mykey2
591 } {0}
592
593 test {RENAMENX against already existing key (2)} {
594 set res [$r get mykey]
595 append res [$r get mykey2]
596 } {foobar}
597
598 test {RENAME against non existing source key} {
599 catch {$r rename nokey foobar} err
600 format $err
601 } {ERR*}
602
603 test {RENAME where source and dest key is the same} {
604 catch {$r rename mykey mykey} err
605 format $err
606 } {ERR*}
607
608 test {DEL all keys again (DB 0)} {
609 foreach key [$r keys *] {
610 $r del $key
611 }
612 $r dbsize
613 } {0}
614
615 test {DEL all keys again (DB 1)} {
616 $r select 10
617 foreach key [$r keys *] {
618 $r del $key
619 }
620 set res [$r dbsize]
621 $r select 9
622 format $res
623 } {0}
624
625 test {MOVE basic usage} {
626 $r set mykey foobar
627 $r move mykey 10
628 set res {}
629 lappend res [$r exists mykey]
630 lappend res [$r dbsize]
631 $r select 10
632 lappend res [$r get mykey]
633 lappend res [$r dbsize]
634 $r select 9
635 format $res
636 } [list 0 0 foobar 1]
637
638 test {MOVE against key existing in the target DB} {
639 $r set mykey hello
640 $r move mykey 10
641 } {0}
642
643 test {SET/GET keys in different DBs} {
644 $r set a hello
645 $r set b world
646 $r select 10
647 $r set a foo
648 $r set b bared
649 $r select 9
650 set res {}
651 lappend res [$r get a]
652 lappend res [$r get b]
653 $r select 10
654 lappend res [$r get a]
655 lappend res [$r get b]
656 $r select 9
657 format $res
658 } {hello world foo bared}
659
660 test {Basic LPOP/RPOP} {
661 $r del mylist
662 $r rpush mylist 1
663 $r rpush mylist 2
664 $r lpush mylist 0
665 list [$r lpop mylist] [$r rpop mylist] [$r lpop mylist] [$r llen mylist]
666 } [list 0 2 1 0]
667
668 test {LPOP/RPOP against empty list} {
669 $r lpop mylist
670 } {}
671
672 test {LPOP against non list value} {
673 $r set notalist foo
674 catch {$r lpop notalist} err
675 format $err
676 } {ERR*kind*}
677
678 test {Mass LPUSH/LPOP} {
679 set sum 0
680 for {set i 0} {$i < 1000} {incr i} {
681 $r lpush mylist $i
682 incr sum $i
683 }
684 set sum2 0
685 for {set i 0} {$i < 500} {incr i} {
686 incr sum2 [$r lpop mylist]
687 incr sum2 [$r rpop mylist]
688 }
689 expr $sum == $sum2
690 } {1}
691
692 test {LRANGE basics} {
693 for {set i 0} {$i < 10} {incr i} {
694 $r rpush mylist $i
695 }
696 list [$r lrange mylist 1 -2] \
697 [$r lrange mylist -3 -1] \
698 [$r lrange mylist 4 4]
699 } {{1 2 3 4 5 6 7 8} {7 8 9} 4}
700
701 test {LRANGE inverted indexes} {
702 $r lrange mylist 6 2
703 } {}
704
705 test {LRANGE out of range indexes including the full list} {
706 $r lrange mylist -1000 1000
707 } {0 1 2 3 4 5 6 7 8 9}
708
709 test {LRANGE against non existing key} {
710 $r lrange nosuchkey 0 1
711 } {}
712
713 test {LTRIM basics} {
714 $r del mylist
715 for {set i 0} {$i < 100} {incr i} {
716 $r lpush mylist $i
717 $r ltrim mylist 0 4
718 }
719 $r lrange mylist 0 -1
720 } {99 98 97 96 95}
721
722 test {LTRIM stress testing} {
723 set mylist {}
724 set err {}
725 for {set i 0} {$i < 20} {incr i} {
726 lappend mylist $i
727 }
728
729 for {set j 0} {$j < 100} {incr j} {
730 # Fill the list
731 $r del mylist
732 for {set i 0} {$i < 20} {incr i} {
733 $r rpush mylist $i
734 }
735 # Trim at random
736 set a [randomInt 20]
737 set b [randomInt 20]
738 $r ltrim mylist $a $b
739 if {[$r lrange mylist 0 -1] ne [lrange $mylist $a $b]} {
740 set err "[$r lrange mylist 0 -1] != [lrange $mylist $a $b]"
741 break
742 }
743 }
744 set _ $err
745 } {}
746
747 test {LSET} {
748 $r del mylist
749 foreach x {99 98 97 96 95} {
750 $r rpush mylist $x
751 }
752 $r lset mylist 1 foo
753 $r lset mylist -1 bar
754 $r lrange mylist 0 -1
755 } {99 foo 97 96 bar}
756
757 test {LSET out of range index} {
758 catch {$r lset mylist 10 foo} err
759 format $err
760 } {ERR*range*}
761
762 test {LSET against non existing key} {
763 catch {$r lset nosuchkey 10 foo} err
764 format $err
765 } {ERR*key*}
766
767 test {LSET against non list value} {
768 $r set nolist foobar
769 catch {$r lset nolist 0 foo} err
770 format $err
771 } {ERR*value*}
772
773 test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
774 $r sadd myset foo
775 $r sadd myset bar
776 list [$r scard myset] [$r sismember myset foo] \
777 [$r sismember myset bar] [$r sismember myset bla] \
778 [lsort [$r smembers myset]]
779 } {2 1 1 0 {bar foo}}
780
781 test {SADD adding the same element multiple times} {
782 $r sadd myset foo
783 $r sadd myset foo
784 $r sadd myset foo
785 $r scard myset
786 } {2}
787
788 test {SADD against non set} {
789 catch {$r sadd mylist foo} err
790 format $err
791 } {ERR*kind*}
792
793 test {SREM basics} {
794 $r sadd myset ciao
795 $r srem myset foo
796 lsort [$r smembers myset]
797 } {bar ciao}
798
799 test {Mass SADD and SINTER with two sets} {
800 for {set i 0} {$i < 1000} {incr i} {
801 $r sadd set1 $i
802 $r sadd set2 [expr $i+995]
803 }
804 lsort [$r sinter set1 set2]
805 } {995 996 997 998 999}
806
807 test {SUNION with two sets} {
808 lsort [$r sunion set1 set2]
809 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
810
811 test {SINTERSTORE with two sets} {
812 $r sinterstore setres set1 set2
813 lsort [$r smembers setres]
814 } {995 996 997 998 999}
815
816 test {SINTERSTORE with two sets, after a DEBUG RELOAD} {
817 $r debug reload
818 $r sinterstore setres set1 set2
819 lsort [$r smembers setres]
820 } {995 996 997 998 999}
821
822 test {SUNIONSTORE with two sets} {
823 $r sunionstore setres set1 set2
824 lsort [$r smembers setres]
825 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
826
827 test {SUNIONSTORE against non existing keys} {
828 $r set setres xxx
829 list [$r sunionstore setres foo111 bar222] [$r exists xxx]
830 } {0 0}
831
832 test {SINTER against three sets} {
833 $r sadd set3 999
834 $r sadd set3 995
835 $r sadd set3 1000
836 $r sadd set3 2000
837 lsort [$r sinter set1 set2 set3]
838 } {995 999}
839
840 test {SINTERSTORE with three sets} {
841 $r sinterstore setres set1 set2 set3
842 lsort [$r smembers setres]
843 } {995 999}
844
845 test {SUNION with non existing keys} {
846 lsort [$r sunion nokey1 set1 set2 nokey2]
847 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
848
849 test {SDIFF with two sets} {
850 for {set i 5} {$i < 1000} {incr i} {
851 $r sadd set4 $i
852 }
853 lsort [$r sdiff set1 set4]
854 } {0 1 2 3 4}
855
856 test {SDIFF with three sets} {
857 $r sadd set5 0
858 lsort [$r sdiff set1 set4 set5]
859 } {1 2 3 4}
860
861 test {SDIFFSTORE with three sets} {
862 $r sdiffstore sres set1 set4 set5
863 lsort [$r smembers sres]
864 } {1 2 3 4}
865
866 test {SPOP basics} {
867 $r del myset
868 $r sadd myset 1
869 $r sadd myset 2
870 $r sadd myset 3
871 list [lsort [list [$r spop myset] [$r spop myset] [$r spop myset]]] [$r scard myset]
872 } {{1 2 3} 0}
873
874 test {SAVE - make sure there are all the types as values} {
875 # Wait for a background saving in progress to terminate
876 waitForBgsave $r
877 $r lpush mysavelist hello
878 $r lpush mysavelist world
879 $r set myemptykey {}
880 $r set mynormalkey {blablablba}
881 $r zadd mytestzset 10 a
882 $r zadd mytestzset 20 b
883 $r zadd mytestzset 30 c
884 $r save
885 } {OK}
886
887 test {SRANDMEMBER} {
888 $r del myset
889 $r sadd myset a
890 $r sadd myset b
891 $r sadd myset c
892 unset -nocomplain myset
893 array set myset {}
894 for {set i 0} {$i < 100} {incr i} {
895 set myset([$r srandmember myset]) 1
896 }
897 lsort [array names myset]
898 } {a b c}
899
900 test {SORT ALPHA against integer encoded strings} {
901 $r del mylist
902 $r lpush mylist 2
903 $r lpush mylist 1
904 $r lpush mylist 3
905 $r lpush mylist 10
906 $r sort mylist alpha
907 } {1 10 2 3}
908
909 test {Create a random list and a random set} {
910 set tosort {}
911 array set seenrand {}
912 for {set i 0} {$i < 10000} {incr i} {
913 while 1 {
914 # Make sure all the weights are different because
915 # Redis does not use a stable sort but Tcl does.
916 randpath {
917 set rint [expr int(rand()*1000000)]
918 } {
919 set rint [expr rand()]
920 }
921 if {![info exists seenrand($rint)]} break
922 }
923 set seenrand($rint) x
924 $r lpush tosort $i
925 $r sadd tosort-set $i
926 $r set weight_$i $rint
927 $r hset wobj_$i weight $rint
928 lappend tosort [list $i $rint]
929 }
930 set sorted [lsort -index 1 -real $tosort]
931 set res {}
932 for {set i 0} {$i < 10000} {incr i} {
933 lappend res [lindex $sorted $i 0]
934 }
935 format {}
936 } {}
937
938 test {SORT with BY against the newly created list} {
939 $r sort tosort {BY weight_*}
940 } $res
941
942 test {SORT with BY (hash field) against the newly created list} {
943 $r sort tosort {BY wobj_*->weight}
944 } $res
945
946 test {SORT with GET (key+hash) with sanity check of each element (list)} {
947 set err {}
948 set l1 [$r sort tosort GET # GET weight_*]
949 set l2 [$r sort tosort GET # GET wobj_*->weight]
950 foreach {id1 w1} $l1 {id2 w2} $l2 {
951 set realweight [$r get weight_$id1]
952 if {$id1 != $id2} {
953 set err "ID mismatch $id1 != $id2"
954 break
955 }
956 if {$realweight != $w1 || $realweight != $w2} {
957 set err "Weights mismatch! w1: $w1 w2: $w2 real: $realweight"
958 break
959 }
960 }
961 set _ $err
962 } {}
963
964 test {SORT with BY, but against the newly created set} {
965 $r sort tosort-set {BY weight_*}
966 } $res
967
968 test {SORT with BY (hash field), but against the newly created set} {
969 $r sort tosort-set {BY wobj_*->weight}
970 } $res
971
972 test {SORT with BY and STORE against the newly created list} {
973 $r sort tosort {BY weight_*} store sort-res
974 $r lrange sort-res 0 -1
975 } $res
976
977 test {SORT with BY (hash field) and STORE against the newly created list} {
978 $r sort tosort {BY wobj_*->weight} store sort-res
979 $r lrange sort-res 0 -1
980 } $res
981
982 test {SORT direct, numeric, against the newly created list} {
983 $r sort tosort
984 } [lsort -integer $res]
985
986 test {SORT decreasing sort} {
987 $r sort tosort {DESC}
988 } [lsort -decreasing -integer $res]
989
990 test {SORT speed, sorting 10000 elements list using BY, 100 times} {
991 set start [clock clicks -milliseconds]
992 for {set i 0} {$i < 100} {incr i} {
993 set sorted [$r sort tosort {BY weight_* LIMIT 0 10}]
994 }
995 set elapsed [expr [clock clicks -milliseconds]-$start]
996 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
997 flush stdout
998 format {}
999 } {}
1000
1001 test {SORT speed, as above but against hash field} {
1002 set start [clock clicks -milliseconds]
1003 for {set i 0} {$i < 100} {incr i} {
1004 set sorted [$r sort tosort {BY wobj_*->weight LIMIT 0 10}]
1005 }
1006 set elapsed [expr [clock clicks -milliseconds]-$start]
1007 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
1008 flush stdout
1009 format {}
1010 } {}
1011
1012 test {SORT speed, sorting 10000 elements list directly, 100 times} {
1013 set start [clock clicks -milliseconds]
1014 for {set i 0} {$i < 100} {incr i} {
1015 set sorted [$r sort tosort {LIMIT 0 10}]
1016 }
1017 set elapsed [expr [clock clicks -milliseconds]-$start]
1018 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
1019 flush stdout
1020 format {}
1021 } {}
1022
1023 test {SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times} {
1024 set start [clock clicks -milliseconds]
1025 for {set i 0} {$i < 100} {incr i} {
1026 set sorted [$r sort tosort {BY nokey LIMIT 0 10}]
1027 }
1028 set elapsed [expr [clock clicks -milliseconds]-$start]
1029 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
1030 flush stdout
1031 format {}
1032 } {}
1033
1034 test {SORT regression for issue #19, sorting floats} {
1035 $r flushdb
1036 foreach x {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15} {
1037 $r lpush mylist $x
1038 }
1039 $r sort mylist
1040 } [lsort -real {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}]
1041
1042 test {SORT with GET #} {
1043 $r del mylist
1044 $r lpush mylist 1
1045 $r lpush mylist 2
1046 $r lpush mylist 3
1047 $r mset weight_1 10 weight_2 5 weight_3 30
1048 $r sort mylist BY weight_* GET #
1049 } {2 1 3}
1050
1051 test {SORT with constant GET} {
1052 $r sort mylist GET foo
1053 } {{} {} {}}
1054
1055 test {LREM, remove all the occurrences} {
1056 $r flushdb
1057 $r rpush mylist foo
1058 $r rpush mylist bar
1059 $r rpush mylist foobar
1060 $r rpush mylist foobared
1061 $r rpush mylist zap
1062 $r rpush mylist bar
1063 $r rpush mylist test
1064 $r rpush mylist foo
1065 set res [$r lrem mylist 0 bar]
1066 list [$r lrange mylist 0 -1] $res
1067 } {{foo foobar foobared zap test foo} 2}
1068
1069 test {LREM, remove the first occurrence} {
1070 set res [$r lrem mylist 1 foo]
1071 list [$r lrange mylist 0 -1] $res
1072 } {{foobar foobared zap test foo} 1}
1073
1074 test {LREM, remove non existing element} {
1075 set res [$r lrem mylist 1 nosuchelement]
1076 list [$r lrange mylist 0 -1] $res
1077 } {{foobar foobared zap test foo} 0}
1078
1079 test {LREM, starting from tail with negative count} {
1080 $r flushdb
1081 $r rpush mylist foo
1082 $r rpush mylist bar
1083 $r rpush mylist foobar
1084 $r rpush mylist foobared
1085 $r rpush mylist zap
1086 $r rpush mylist bar
1087 $r rpush mylist test
1088 $r rpush mylist foo
1089 $r rpush mylist foo
1090 set res [$r lrem mylist -1 bar]
1091 list [$r lrange mylist 0 -1] $res
1092 } {{foo bar foobar foobared zap test foo foo} 1}
1093
1094 test {LREM, starting from tail with negative count (2)} {
1095 set res [$r lrem mylist -2 foo]
1096 list [$r lrange mylist 0 -1] $res
1097 } {{foo bar foobar foobared zap test} 2}
1098
1099 test {LREM, deleting objects that may be encoded as integers} {
1100 $r lpush myotherlist 1
1101 $r lpush myotherlist 2
1102 $r lpush myotherlist 3
1103 $r lrem myotherlist 1 2
1104 $r llen myotherlist
1105 } {2}
1106
1107 test {MGET} {
1108 $r flushdb
1109 $r set foo BAR
1110 $r set bar FOO
1111 $r mget foo bar
1112 } {BAR FOO}
1113
1114 test {MGET against non existing key} {
1115 $r mget foo baazz bar
1116 } {BAR {} FOO}
1117
1118 test {MGET against non-string key} {
1119 $r sadd myset ciao
1120 $r sadd myset bau
1121 $r mget foo baazz bar myset
1122 } {BAR {} FOO {}}
1123
1124 test {RANDOMKEY} {
1125 $r flushdb
1126 $r set foo x
1127 $r set bar y
1128 set foo_seen 0
1129 set bar_seen 0
1130 for {set i 0} {$i < 100} {incr i} {
1131 set rkey [$r randomkey]
1132 if {$rkey eq {foo}} {
1133 set foo_seen 1
1134 }
1135 if {$rkey eq {bar}} {
1136 set bar_seen 1
1137 }
1138 }
1139 list $foo_seen $bar_seen
1140 } {1 1}
1141
1142 test {RANDOMKEY against empty DB} {
1143 $r flushdb
1144 $r randomkey
1145 } {}
1146
1147 test {RANDOMKEY regression 1} {
1148 $r flushdb
1149 $r set x 10
1150 $r del x
1151 $r randomkey
1152 } {}
1153
1154 test {GETSET (set new value)} {
1155 list [$r getset foo xyz] [$r get foo]
1156 } {{} xyz}
1157
1158 test {GETSET (replace old value)} {
1159 $r set foo bar
1160 list [$r getset foo xyz] [$r get foo]
1161 } {bar xyz}
1162
1163 test {SMOVE basics} {
1164 $r sadd myset1 a
1165 $r sadd myset1 b
1166 $r sadd myset1 c
1167 $r sadd myset2 x
1168 $r sadd myset2 y
1169 $r sadd myset2 z
1170 $r smove myset1 myset2 a
1171 list [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
1172 } {{a x y z} {b c}}
1173
1174 test {SMOVE non existing key} {
1175 list [$r smove myset1 myset2 foo] [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
1176 } {0 {a x y z} {b c}}
1177
1178 test {SMOVE non existing src set} {
1179 list [$r smove noset myset2 foo] [lsort [$r smembers myset2]]
1180 } {0 {a x y z}}
1181
1182 test {SMOVE non existing dst set} {
1183 list [$r smove myset2 myset3 y] [lsort [$r smembers myset2]] [lsort [$r smembers myset3]]
1184 } {1 {a x z} y}
1185
1186 test {SMOVE wrong src key type} {
1187 $r set x 10
1188 catch {$r smove x myset2 foo} err
1189 format $err
1190 } {ERR*}
1191
1192 test {SMOVE wrong dst key type} {
1193 $r set x 10
1194 catch {$r smove myset2 x foo} err
1195 format $err
1196 } {ERR*}
1197
1198 test {MSET base case} {
1199 $r mset x 10 y "foo bar" z "x x x x x x x\n\n\r\n"
1200 $r mget x y z
1201 } [list 10 {foo bar} "x x x x x x x\n\n\r\n"]
1202
1203 test {MSET wrong number of args} {
1204 catch {$r mset x 10 y "foo bar" z} err
1205 format $err
1206 } {*wrong number*}
1207
1208 test {MSETNX with already existent key} {
1209 list [$r msetnx x1 xxx y2 yyy x 20] [$r exists x1] [$r exists y2]
1210 } {0 0 0}
1211
1212 test {MSETNX with not existing keys} {
1213 list [$r msetnx x1 xxx y2 yyy] [$r get x1] [$r get y2]
1214 } {1 xxx yyy}
1215
1216 test {MSETNX should remove all the volatile keys even on failure} {
1217 $r mset x 1 y 2 z 3
1218 $r expire y 10000
1219 $r expire z 10000
1220 list [$r msetnx x A y B z C] [$r mget x y z]
1221 } {0 {1 {} {}}}
1222
1223 test {ZSET basic ZADD and score update} {
1224 $r zadd ztmp 10 x
1225 $r zadd ztmp 20 y
1226 $r zadd ztmp 30 z
1227 set aux1 [$r zrange ztmp 0 -1]
1228 $r zadd ztmp 1 y
1229 set aux2 [$r zrange ztmp 0 -1]
1230 list $aux1 $aux2
1231 } {{x y z} {y x z}}
1232
1233 test {ZCARD basics} {
1234 $r zcard ztmp
1235 } {3}
1236
1237 test {ZCARD non existing key} {
1238 $r zcard ztmp-blabla
1239 } {0}
1240
1241 test {ZRANK basics} {
1242 $r zadd zranktmp 10 x
1243 $r zadd zranktmp 20 y
1244 $r zadd zranktmp 30 z
1245 list [$r zrank zranktmp x] [$r zrank zranktmp y] [$r zrank zranktmp z]
1246 } {0 1 2}
1247
1248 test {ZREVRANK basics} {
1249 list [$r zrevrank zranktmp x] [$r zrevrank zranktmp y] [$r zrevrank zranktmp z]
1250 } {2 1 0}
1251
1252 test {ZRANK - after deletion} {
1253 $r zrem zranktmp y
1254 list [$r zrank zranktmp x] [$r zrank zranktmp z]
1255 } {0 1}
1256
1257 test {ZSCORE} {
1258 set aux {}
1259 set err {}
1260 for {set i 0} {$i < 1000} {incr i} {
1261 set score [expr rand()]
1262 lappend aux $score
1263 $r zadd zscoretest $score $i
1264 }
1265 for {set i 0} {$i < 1000} {incr i} {
1266 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
1267 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
1268 break
1269 }
1270 }
1271 set _ $err
1272 } {}
1273
1274 test {ZSCORE after a DEBUG RELOAD} {
1275 set aux {}
1276 set err {}
1277 $r del zscoretest
1278 for {set i 0} {$i < 1000} {incr i} {
1279 set score [expr rand()]
1280 lappend aux $score
1281 $r zadd zscoretest $score $i
1282 }
1283 $r debug reload
1284 for {set i 0} {$i < 1000} {incr i} {
1285 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
1286 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
1287 break
1288 }
1289 }
1290 set _ $err
1291 } {}
1292
1293 test {ZRANGE and ZREVRANGE basics} {
1294 list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1] \
1295 [$r zrange ztmp 1 -1] [$r zrevrange ztmp 1 -1]
1296 } {{y x z} {z x y} {x z} {x y}}
1297
1298 test {ZRANGE WITHSCORES} {
1299 $r zrange ztmp 0 -1 withscores
1300 } {y 1 x 10 z 30}
1301
1302 test {ZSETs stress tester - sorting is working well?} {
1303 set delta 0
1304 for {set test 0} {$test < 2} {incr test} {
1305 unset -nocomplain auxarray
1306 array set auxarray {}
1307 set auxlist {}
1308 $r del myzset
1309 for {set i 0} {$i < 1000} {incr i} {
1310 if {$test == 0} {
1311 set score [expr rand()]
1312 } else {
1313 set score [expr int(rand()*10)]
1314 }
1315 set auxarray($i) $score
1316 $r zadd myzset $score $i
1317 # Random update
1318 if {[expr rand()] < .2} {
1319 set j [expr int(rand()*1000)]
1320 if {$test == 0} {
1321 set score [expr rand()]
1322 } else {
1323 set score [expr int(rand()*10)]
1324 }
1325 set auxarray($j) $score
1326 $r zadd myzset $score $j
1327 }
1328 }
1329 foreach {item score} [array get auxarray] {
1330 lappend auxlist [list $score $item]
1331 }
1332 set sorted [lsort -command zlistAlikeSort $auxlist]
1333 set auxlist {}
1334 foreach x $sorted {
1335 lappend auxlist [lindex $x 1]
1336 }
1337 set fromredis [$r zrange myzset 0 -1]
1338 set delta 0
1339 for {set i 0} {$i < [llength $fromredis]} {incr i} {
1340 if {[lindex $fromredis $i] != [lindex $auxlist $i]} {
1341 incr delta
1342 }
1343 }
1344 }
1345 format $delta
1346 } {0}
1347
1348 test {ZINCRBY - can create a new sorted set} {
1349 $r del zset
1350 $r zincrby zset 1 foo
1351 list [$r zrange zset 0 -1] [$r zscore zset foo]
1352 } {foo 1}
1353
1354 test {ZINCRBY - increment and decrement} {
1355 $r zincrby zset 2 foo
1356 $r zincrby zset 1 bar
1357 set v1 [$r zrange zset 0 -1]
1358 $r zincrby zset 10 bar
1359 $r zincrby zset -5 foo
1360 $r zincrby zset -5 bar
1361 set v2 [$r zrange zset 0 -1]
1362 list $v1 $v2 [$r zscore zset foo] [$r zscore zset bar]
1363 } {{bar foo} {foo bar} -2 6}
1364
1365 test {ZRANGEBYSCORE and ZCOUNT basics} {
1366 $r del zset
1367 $r zadd zset 1 a
1368 $r zadd zset 2 b
1369 $r zadd zset 3 c
1370 $r zadd zset 4 d
1371 $r zadd zset 5 e
1372 list [$r zrangebyscore zset 2 4] [$r zrangebyscore zset (2 (4] \
1373 [$r zcount zset 2 4] [$r zcount zset (2 (4]
1374 } {{b c d} c 3 1}
1375
1376 test {ZRANGEBYSCORE withscores} {
1377 $r del zset
1378 $r zadd zset 1 a
1379 $r zadd zset 2 b
1380 $r zadd zset 3 c
1381 $r zadd zset 4 d
1382 $r zadd zset 5 e
1383 $r zrangebyscore zset 2 4 withscores
1384 } {b 2 c 3 d 4}
1385
1386 test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
1387 set err {}
1388 $r del zset
1389 for {set i 0} {$i < 1000} {incr i} {
1390 $r zadd zset [expr rand()] $i
1391 }
1392 for {set i 0} {$i < 100} {incr i} {
1393 set min [expr rand()]
1394 set max [expr rand()]
1395 if {$min > $max} {
1396 set aux $min
1397 set min $max
1398 set max $aux
1399 }
1400 set low [$r zrangebyscore zset -inf $min]
1401 set ok [$r zrangebyscore zset $min $max]
1402 set high [$r zrangebyscore zset $max +inf]
1403 set lowx [$r zrangebyscore zset -inf ($min]
1404 set okx [$r zrangebyscore zset ($min ($max]
1405 set highx [$r zrangebyscore zset ($max +inf]
1406
1407 if {[$r zcount zset -inf $min] != [llength $low]} {
1408 append err "Error, len does not match zcount\n"
1409 }
1410 if {[$r zcount zset $min $max] != [llength $ok]} {
1411 append err "Error, len does not match zcount\n"
1412 }
1413 if {[$r zcount zset $max +inf] != [llength $high]} {
1414 append err "Error, len does not match zcount\n"
1415 }
1416 if {[$r zcount zset -inf ($min] != [llength $lowx]} {
1417 append err "Error, len does not match zcount\n"
1418 }
1419 if {[$r zcount zset ($min ($max] != [llength $okx]} {
1420 append err "Error, len does not match zcount\n"
1421 }
1422 if {[$r zcount zset ($max +inf] != [llength $highx]} {
1423 append err "Error, len does not match zcount\n"
1424 }
1425
1426 foreach x $low {
1427 set score [$r zscore zset $x]
1428 if {$score > $min} {
1429 append err "Error, score for $x is $score > $min\n"
1430 }
1431 }
1432 foreach x $lowx {
1433 set score [$r zscore zset $x]
1434 if {$score >= $min} {
1435 append err "Error, score for $x is $score >= $min\n"
1436 }
1437 }
1438 foreach x $ok {
1439 set score [$r zscore zset $x]
1440 if {$score < $min || $score > $max} {
1441 append err "Error, score for $x is $score outside $min-$max range\n"
1442 }
1443 }
1444 foreach x $okx {
1445 set score [$r zscore zset $x]
1446 if {$score <= $min || $score >= $max} {
1447 append err "Error, score for $x is $score outside $min-$max open range\n"
1448 }
1449 }
1450 foreach x $high {
1451 set score [$r zscore zset $x]
1452 if {$score < $max} {
1453 append err "Error, score for $x is $score < $max\n"
1454 }
1455 }
1456 foreach x $highx {
1457 set score [$r zscore zset $x]
1458 if {$score <= $max} {
1459 append err "Error, score for $x is $score <= $max\n"
1460 }
1461 }
1462 }
1463 set _ $err
1464 } {}
1465
1466 test {ZRANGEBYSCORE with LIMIT} {
1467 $r del zset
1468 $r zadd zset 1 a
1469 $r zadd zset 2 b
1470 $r zadd zset 3 c
1471 $r zadd zset 4 d
1472 $r zadd zset 5 e
1473 list \
1474 [$r zrangebyscore zset 0 10 LIMIT 0 2] \
1475 [$r zrangebyscore zset 0 10 LIMIT 2 3] \
1476 [$r zrangebyscore zset 0 10 LIMIT 2 10] \
1477 [$r zrangebyscore zset 0 10 LIMIT 20 10]
1478 } {{a b} {c d e} {c d e} {}}
1479
1480 test {ZRANGEBYSCORE with LIMIT and withscores} {
1481 $r del zset
1482 $r zadd zset 10 a
1483 $r zadd zset 20 b
1484 $r zadd zset 30 c
1485 $r zadd zset 40 d
1486 $r zadd zset 50 e
1487 $r zrangebyscore zset 20 50 LIMIT 2 3 withscores
1488 } {d 40 e 50}
1489
1490 test {ZREMRANGEBYSCORE basics} {
1491 $r del zset
1492 $r zadd zset 1 a
1493 $r zadd zset 2 b
1494 $r zadd zset 3 c
1495 $r zadd zset 4 d
1496 $r zadd zset 5 e
1497 list [$r zremrangebyscore zset 2 4] [$r zrange zset 0 -1]
1498 } {3 {a e}}
1499
1500 test {ZREMRANGEBYSCORE from -inf to +inf} {
1501 $r del zset
1502 $r zadd zset 1 a
1503 $r zadd zset 2 b
1504 $r zadd zset 3 c
1505 $r zadd zset 4 d
1506 $r zadd zset 5 e
1507 list [$r zremrangebyscore zset -inf +inf] [$r zrange zset 0 -1]
1508 } {5 {}}
1509
1510 test {ZREMRANGEBYRANK basics} {
1511 $r del zset
1512 $r zadd zset 1 a
1513 $r zadd zset 2 b
1514 $r zadd zset 3 c
1515 $r zadd zset 4 d
1516 $r zadd zset 5 e
1517 list [$r zremrangebyrank zset 1 3] [$r zrange zset 0 -1]
1518 } {3 {a e}}
1519
1520 test {ZUNION against non-existing key doesn't set destination} {
1521 $r del zseta
1522 list [$r zunion dst_key 1 zseta] [$r exists dst_key]
1523 } {0 0}
1524
1525 test {ZUNION basics} {
1526 $r del zseta zsetb zsetc
1527 $r zadd zseta 1 a
1528 $r zadd zseta 2 b
1529 $r zadd zseta 3 c
1530 $r zadd zsetb 1 b
1531 $r zadd zsetb 2 c
1532 $r zadd zsetb 3 d
1533 list [$r zunion zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
1534 } {4 {a 1 b 3 d 3 c 5}}
1535
1536 test {ZUNION with weights} {
1537 list [$r zunion zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
1538 } {4 {a 2 b 7 d 9 c 12}}
1539
1540 test {ZUNION with AGGREGATE MIN} {
1541 list [$r zunion zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores]
1542 } {4 {a 1 b 1 c 2 d 3}}
1543
1544 test {ZUNION with AGGREGATE MAX} {
1545 list [$r zunion zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores]
1546 } {4 {a 1 b 2 c 3 d 3}}
1547
1548 test {ZINTER basics} {
1549 list [$r zinter zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
1550 } {2 {b 3 c 5}}
1551
1552 test {ZINTER with weights} {
1553 list [$r zinter zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
1554 } {2 {b 7 c 12}}
1555
1556 test {ZINTER with AGGREGATE MIN} {
1557 list [$r zinter zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores]
1558 } {2 {b 1 c 2}}
1559
1560 test {ZINTER with AGGREGATE MAX} {
1561 list [$r zinter zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores]
1562 } {2 {b 2 c 3}}
1563
1564 test {SORT against sorted sets} {
1565 $r del zset
1566 $r zadd zset 1 a
1567 $r zadd zset 5 b
1568 $r zadd zset 2 c
1569 $r zadd zset 10 d
1570 $r zadd zset 3 e
1571 $r sort zset alpha desc
1572 } {e d c b a}
1573
1574 test {Sorted sets +inf and -inf handling} {
1575 $r del zset
1576 $r zadd zset -100 a
1577 $r zadd zset 200 b
1578 $r zadd zset -300 c
1579 $r zadd zset 1000000 d
1580 $r zadd zset +inf max
1581 $r zadd zset -inf min
1582 $r zrange zset 0 -1
1583 } {min c a b d max}
1584
1585 test {HSET/HLEN - Small hash creation} {
1586 array set smallhash {}
1587 for {set i 0} {$i < 8} {incr i} {
1588 set key [randstring 0 8 alpha]
1589 set val [randstring 0 8 alpha]
1590 if {[info exists smallhash($key)]} {
1591 incr i -1
1592 continue
1593 }
1594 $r hset smallhash $key $val
1595 set smallhash($key) $val
1596 }
1597 list [$r hlen smallhash]
1598 } {8}
1599
1600 test {Is the small hash encoded with a zipmap?} {
1601 $r debug object smallhash
1602 } {*zipmap*}
1603
1604 test {HSET/HLEN - Big hash creation} {
1605 array set bighash {}
1606 for {set i 0} {$i < 1024} {incr i} {
1607 set key [randstring 0 8 alpha]
1608 set val [randstring 0 8 alpha]
1609 if {[info exists bighash($key)]} {
1610 incr i -1
1611 continue
1612 }
1613 $r hset bighash $key $val
1614 set bighash($key) $val
1615 }
1616 list [$r hlen bighash]
1617 } {1024}
1618
1619 test {Is the big hash encoded with a zipmap?} {
1620 $r debug object bighash
1621 } {*hashtable*}
1622
1623 test {HGET against the small hash} {
1624 set err {}
1625 foreach k [array names smallhash *] {
1626 if {$smallhash($k) ne [$r hget smallhash $k]} {
1627 set err "$smallhash($k) != [$r hget smallhash $k]"
1628 break
1629 }
1630 }
1631 set _ $err
1632 } {}
1633
1634 test {HGET against the big hash} {
1635 set err {}
1636 foreach k [array names bighash *] {
1637 if {$bighash($k) ne [$r hget bighash $k]} {
1638 set err "$bighash($k) != [$r hget bighash $k]"
1639 break
1640 }
1641 }
1642 set _ $err
1643 } {}
1644
1645 test {HGET against non existing key} {
1646 set rv {}
1647 lappend rv [$r hget smallhash __123123123__]
1648 lappend rv [$r hget bighash __123123123__]
1649 set _ $rv
1650 } {{} {}}
1651
1652 test {HSET in update and insert mode} {
1653 set rv {}
1654 set k [lindex [array names smallhash *] 0]
1655 lappend rv [$r hset smallhash $k newval1]
1656 set smallhash($k) newval1
1657 lappend rv [$r hget smallhash $k]
1658 lappend rv [$r hset smallhash __foobar123__ newval]
1659 set k [lindex [array names bighash *] 0]
1660 lappend rv [$r hset bighash $k newval2]
1661 set bighash($k) newval2
1662 lappend rv [$r hget bighash $k]
1663 lappend rv [$r hset bighash __foobar123__ newval]
1664 lappend rv [$r hdel smallhash __foobar123__]
1665 lappend rv [$r hdel bighash __foobar123__]
1666 set _ $rv
1667 } {0 newval1 1 0 newval2 1 1 1}
1668
1669 test {HSETNX target key missing - small hash} {
1670 $r hsetnx smallhash __123123123__ foo
1671 $r hget smallhash __123123123__
1672 } {foo}
1673
1674 test {HSETNX target key exists - small hash} {
1675 $r hsetnx smallhash __123123123__ bar
1676 set result [$r hget smallhash __123123123__]
1677 $r hdel smallhash __123123123__
1678 set _ $result
1679 } {foo}
1680
1681 test {HSETNX target key missing - big hash} {
1682 $r hsetnx bighash __123123123__ foo
1683 $r hget bighash __123123123__
1684 } {foo}
1685
1686 test {HSETNX target key exists - big hash} {
1687 $r hsetnx bighash __123123123__ bar
1688 set result [$r hget bighash __123123123__]
1689 $r hdel bighash __123123123__
1690 set _ $result
1691 } {foo}
1692
1693 test {HMSET wrong number of args} {
1694 catch {$r hmset smallhash key1 val1 key2} err
1695 format $err
1696 } {*wrong number*}
1697
1698 test {HMSET - small hash} {
1699 set args {}
1700 foreach {k v} [array get smallhash] {
1701 set newval [randstring 0 8 alpha]
1702 set smallhash($k) $newval
1703 lappend args $k $newval
1704 }
1705 $r hmset smallhash {*}$args
1706 } {OK}
1707
1708 test {HMSET - big hash} {
1709 set args {}
1710 foreach {k v} [array get bighash] {
1711 set newval [randstring 0 8 alpha]
1712 set bighash($k) $newval
1713 lappend args $k $newval
1714 }
1715 $r hmset bighash {*}$args
1716 } {OK}
1717
1718 test {HMGET against non existing key and fields} {
1719 set rv {}
1720 lappend rv [$r hmget doesntexist __123123123__ __456456456__]
1721 lappend rv [$r hmget smallhash __123123123__ __456456456__]
1722 lappend rv [$r hmget bighash __123123123__ __456456456__]
1723 set _ $rv
1724 } {{{} {}} {{} {}} {{} {}}}
1725
1726 test {HMGET - small hash} {
1727 set keys {}
1728 set vals {}
1729 foreach {k v} [array get smallhash] {
1730 lappend keys $k
1731 lappend vals $v
1732 }
1733 set err {}
1734 set result [$r hmget smallhash {*}$keys]
1735 if {$vals ne $result} {
1736 set err "$vals != $result"
1737 break
1738 }
1739 set _ $err
1740 } {}
1741
1742 test {HMGET - big hash} {
1743 set keys {}
1744 set vals {}
1745 foreach {k v} [array get bighash] {
1746 lappend keys $k
1747 lappend vals $v
1748 }
1749 set err {}
1750 set result [$r hmget bighash {*}$keys]
1751 if {$vals ne $result} {
1752 set err "$vals != $result"
1753 break
1754 }
1755 set _ $err
1756 } {}
1757
1758 test {HKEYS - small hash} {
1759 lsort [$r hkeys smallhash]
1760 } [lsort [array names smallhash *]]
1761
1762 test {HKEYS - big hash} {
1763 lsort [$r hkeys bighash]
1764 } [lsort [array names bighash *]]
1765
1766 test {HVALS - small hash} {
1767 set vals {}
1768 foreach {k v} [array get smallhash] {
1769 lappend vals $v
1770 }
1771 set _ [lsort $vals]
1772 } [lsort [$r hvals smallhash]]
1773
1774 test {HVALS - big hash} {
1775 set vals {}
1776 foreach {k v} [array get bighash] {
1777 lappend vals $v
1778 }
1779 set _ [lsort $vals]
1780 } [lsort [$r hvals bighash]]
1781
1782 test {HGETALL - small hash} {
1783 lsort [$r hgetall smallhash]
1784 } [lsort [array get smallhash]]
1785
1786 test {HGETALL - big hash} {
1787 lsort [$r hgetall bighash]
1788 } [lsort [array get bighash]]
1789
1790 test {HDEL and return value} {
1791 set rv {}
1792 lappend rv [$r hdel smallhash nokey]
1793 lappend rv [$r hdel bighash nokey]
1794 set k [lindex [array names smallhash *] 0]
1795 lappend rv [$r hdel smallhash $k]
1796 lappend rv [$r hdel smallhash $k]
1797 lappend rv [$r hget smallhash $k]
1798 unset smallhash($k)
1799 set k [lindex [array names bighash *] 0]
1800 lappend rv [$r hdel bighash $k]
1801 lappend rv [$r hdel bighash $k]
1802 lappend rv [$r hget bighash $k]
1803 unset bighash($k)
1804 set _ $rv
1805 } {0 0 1 0 {} 1 0 {}}
1806
1807 test {HEXISTS} {
1808 set rv {}
1809 set k [lindex [array names smallhash *] 0]
1810 lappend rv [$r hexists smallhash $k]
1811 lappend rv [$r hexists smallhash nokey]
1812 set k [lindex [array names bighash *] 0]
1813 lappend rv [$r hexists bighash $k]
1814 lappend rv [$r hexists bighash nokey]
1815 } {1 0 1 0}
1816
1817 test {Is a zipmap encoded Hash promoted on big payload?} {
1818 $r hset smallhash foo [string repeat a 1024]
1819 $r debug object smallhash
1820 } {*hashtable*}
1821
1822 test {HINCRBY against non existing database key} {
1823 $r del htest
1824 list [$r hincrby htest foo 2]
1825 } {2}
1826
1827 test {HINCRBY against non existing hash key} {
1828 set rv {}
1829 $r hdel smallhash tmp
1830 $r hdel bighash tmp
1831 lappend rv [$r hincrby smallhash tmp 2]
1832 lappend rv [$r hget smallhash tmp]
1833 lappend rv [$r hincrby bighash tmp 2]
1834 lappend rv [$r hget bighash tmp]
1835 } {2 2 2 2}
1836
1837 test {HINCRBY against hash key created by hincrby itself} {
1838 set rv {}
1839 lappend rv [$r hincrby smallhash tmp 3]
1840 lappend rv [$r hget smallhash tmp]
1841 lappend rv [$r hincrby bighash tmp 3]
1842 lappend rv [$r hget bighash tmp]
1843 } {5 5 5 5}
1844
1845 test {HINCRBY against hash key originally set with HSET} {
1846 $r hset smallhash tmp 100
1847 $r hset bighash tmp 100
1848 list [$r hincrby smallhash tmp 2] [$r hincrby bighash tmp 2]
1849 } {102 102}
1850
1851 test {HINCRBY over 32bit value} {
1852 $r hset smallhash tmp 17179869184
1853 $r hset bighash tmp 17179869184
1854 list [$r hincrby smallhash tmp 1] [$r hincrby bighash tmp 1]
1855 } {17179869185 17179869185}
1856
1857 test {HINCRBY over 32bit value with over 32bit increment} {
1858 $r hset smallhash tmp 17179869184
1859 $r hset bighash tmp 17179869184
1860 list [$r hincrby smallhash tmp 17179869184] [$r hincrby bighash tmp 17179869184]
1861 } {34359738368 34359738368}
1862
1863 test {HINCRBY fails against hash value with spaces} {
1864 $r hset smallhash str " 11 "
1865 $r hset bighash str " 11 "
1866 catch {$r hincrby smallhash str 1} smallerr
1867 catch {$r hincrby smallhash str 1} bigerr
1868 set rv {}
1869 lappend rv [string match "ERR*not an integer*" $smallerr]
1870 lappend rv [string match "ERR*not an integer*" $bigerr]
1871 } {1 1}
1872
1873 # TODO:
1874 # Randomized test, small and big
1875 # .rdb / AOF consistency test should include hashes
1876
1877 test {EXPIRE - don't set timeouts multiple times} {
1878 $r set x foobar
1879 set v1 [$r expire x 5]
1880 set v2 [$r ttl x]
1881 set v3 [$r expire x 10]
1882 set v4 [$r ttl x]
1883 list $v1 $v2 $v3 $v4
1884 } {1 5 0 5}
1885
1886 test {EXPIRE - It should be still possible to read 'x'} {
1887 $r get x
1888 } {foobar}
1889
1890 test {EXPIRE - After 6 seconds the key should no longer be here} {
1891 after 6000
1892 list [$r get x] [$r exists x]
1893 } {{} 0}
1894
1895 test {EXPIRE - Delete on write policy} {
1896 $r del x
1897 $r lpush x foo
1898 $r expire x 1000
1899 $r lpush x bar
1900 $r lrange x 0 -1
1901 } {bar}
1902
1903 test {EXPIREAT - Check for EXPIRE alike behavior} {
1904 $r del x
1905 $r set x foo
1906 $r expireat x [expr [clock seconds]+15]
1907 $r ttl x
1908 } {1[345]}
1909
1910 test {SETEX - Set + Expire combo operation. Check for TTL} {
1911 $r setex x 12 test
1912 $r ttl x
1913 } {1[012]}
1914
1915 test {SETEX - Check value} {
1916 $r get x
1917 } {test}
1918
1919 test {SETEX - Overwrite old key} {
1920 $r setex y 1 foo
1921 $r get y
1922 } {foo}
1923
1924 test {SETEX - Wait for the key to expire} {
1925 after 3000
1926 $r get y
1927 } {}
1928
1929 test {SETEX - Wrong time parameter} {
1930 catch {$r setex z -10 foo} e
1931 set _ $e
1932 } {*invalid expire*}
1933
1934 test {ZSETs skiplist implementation backlink consistency test} {
1935 set diff 0
1936 set elements 10000
1937 for {set j 0} {$j < $elements} {incr j} {
1938 $r zadd myzset [expr rand()] "Element-$j"
1939 $r zrem myzset "Element-[expr int(rand()*$elements)]"
1940 }
1941 set l1 [$r zrange myzset 0 -1]
1942 set l2 [$r zrevrange myzset 0 -1]
1943 for {set j 0} {$j < [llength $l1]} {incr j} {
1944 if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
1945 incr diff
1946 }
1947 }
1948 format $diff
1949 } {0}
1950
1951 test {ZSETs ZRANK augmented skip list stress testing} {
1952 set err {}
1953 $r del myzset
1954 for {set k 0} {$k < 10000} {incr k} {
1955 set i [expr {$k%1000}]
1956 if {[expr rand()] < .2} {
1957 $r zrem myzset $i
1958 } else {
1959 set score [expr rand()]
1960 $r zadd myzset $score $i
1961 }
1962 set card [$r zcard myzset]
1963 if {$card > 0} {
1964 set index [randomInt $card]
1965 set ele [lindex [$r zrange myzset $index $index] 0]
1966 set rank [$r zrank myzset $ele]
1967 if {$rank != $index} {
1968 set err "$ele RANK is wrong! ($rank != $index)"
1969 break
1970 }
1971 }
1972 }
1973 set _ $err
1974 } {}
1975
1976 foreach fuzztype {binary alpha compr} {
1977 test "FUZZ stresser with data model $fuzztype" {
1978 set err 0
1979 for {set i 0} {$i < 10000} {incr i} {
1980 set fuzz [randstring 0 512 $fuzztype]
1981 $r set foo $fuzz
1982 set got [$r get foo]
1983 if {$got ne $fuzz} {
1984 set err [list $fuzz $got]
1985 break
1986 }
1987 }
1988 set _ $err
1989 } {0}
1990 }
1991
1992 test {BGSAVE} {
1993 waitForBgsave $r
1994 $r flushdb
1995 $r save
1996 $r set x 10
1997 $r bgsave
1998 waitForBgsave $r
1999 $r debug reload
2000 $r get x
2001 } {10}
2002
2003 test {Handle an empty query well} {
2004 set fd [$r channel]
2005 puts -nonewline $fd "\r\n"
2006 flush $fd
2007 $r ping
2008 } {PONG}
2009
2010 test {Negative multi bulk command does not create problems} {
2011 set fd [$r channel]
2012 puts -nonewline $fd "*-10\r\n"
2013 flush $fd
2014 $r ping
2015 } {PONG}
2016
2017 test {Negative multi bulk payload} {
2018 set fd [$r channel]
2019 puts -nonewline $fd "SET x -10\r\n"
2020 flush $fd
2021 gets $fd
2022 } {*invalid bulk*}
2023
2024 test {Too big bulk payload} {
2025 set fd [$r channel]
2026 puts -nonewline $fd "SET x 2000000000\r\n"
2027 flush $fd
2028 gets $fd
2029 } {*invalid bulk*count*}
2030
2031 test {Multi bulk request not followed by bulk args} {
2032 set fd [$r channel]
2033 puts -nonewline $fd "*1\r\nfoo\r\n"
2034 flush $fd
2035 gets $fd
2036 } {*protocol error*}
2037
2038 test {Generic wrong number of args} {
2039 catch {$r ping x y z} err
2040 set _ $err
2041 } {*wrong*arguments*ping*}
2042
2043 test {SELECT an out of range DB} {
2044 catch {$r select 1000000} err
2045 set _ $err
2046 } {*invalid*}
2047
2048 if {![catch {package require sha1}]} {
2049 test {Check consistency of different data types after a reload} {
2050 $r flushdb
2051 createComplexDataset $r 10000
2052 set sha1 [datasetDigest $r]
2053 $r debug reload
2054 set sha1_after [datasetDigest $r]
2055 expr {$sha1 eq $sha1_after}
2056 } {1}
2057
2058 test {Same dataset digest if saving/reloading as AOF?} {
2059 $r bgrewriteaof
2060 waitForBgrewriteaof $r
2061 $r debug loadaof
2062 set sha1_after [datasetDigest $r]
2063 expr {$sha1 eq $sha1_after}
2064 } {1}
2065 }
2066
2067 test {EXPIRES after a reload (snapshot + append only file)} {
2068 $r flushdb
2069 $r set x 10
2070 $r expire x 1000
2071 $r save
2072 $r debug reload
2073 set ttl [$r ttl x]
2074 set e1 [expr {$ttl > 900 && $ttl <= 1000}]
2075 $r bgrewriteaof
2076 waitForBgrewriteaof $r
2077 set ttl [$r ttl x]
2078 set e2 [expr {$ttl > 900 && $ttl <= 1000}]
2079 list $e1 $e2
2080 } {1 1}
2081
2082 test {PIPELINING stresser (also a regression for the old epoll bug)} {
2083 set fd2 [socket $::host $::port]
2084 fconfigure $fd2 -encoding binary -translation binary
2085 puts -nonewline $fd2 "SELECT 9\r\n"
2086 flush $fd2
2087 gets $fd2
2088
2089 for {set i 0} {$i < 100000} {incr i} {
2090 set q {}
2091 set val "0000${i}0000"
2092 append q "SET key:$i [string length $val]\r\n$val\r\n"
2093 puts -nonewline $fd2 $q
2094 set q {}
2095 append q "GET key:$i\r\n"
2096 puts -nonewline $fd2 $q
2097 }
2098 flush $fd2
2099
2100 for {set i 0} {$i < 100000} {incr i} {
2101 gets $fd2 line
2102 gets $fd2 count
2103 set count [string range $count 1 end]
2104 set val [read $fd2 $count]
2105 read $fd2 2
2106 }
2107 close $fd2
2108 set _ 1
2109 } {1}
2110
2111 test {MUTLI / EXEC basics} {
2112 $r del mylist
2113 $r rpush mylist a
2114 $r rpush mylist b
2115 $r rpush mylist c
2116 $r multi
2117 set v1 [$r lrange mylist 0 -1]
2118 set v2 [$r ping]
2119 set v3 [$r exec]
2120 list $v1 $v2 $v3
2121 } {QUEUED QUEUED {{a b c} PONG}}
2122
2123 test {DISCARD} {
2124 $r del mylist
2125 $r rpush mylist a
2126 $r rpush mylist b
2127 $r rpush mylist c
2128 $r multi
2129 set v1 [$r del mylist]
2130 set v2 [$r discard]
2131 set v3 [$r lrange mylist 0 -1]
2132 list $v1 $v2 $v3
2133 } {QUEUED OK {a b c}}
2134
2135 test {APPEND basics} {
2136 list [$r append foo bar] [$r get foo] \
2137 [$r append foo 100] [$r get foo]
2138 } {3 bar 6 bar100}
2139
2140 test {APPEND basics, integer encoded values} {
2141 set res {}
2142 $r del foo
2143 $r append foo 1
2144 $r append foo 2
2145 lappend res [$r get foo]
2146 $r set foo 1
2147 $r append foo 2
2148 lappend res [$r get foo]
2149 } {12 12}
2150
2151 test {APPEND fuzzing} {
2152 set err {}
2153 foreach type {binary alpha compr} {
2154 set buf {}
2155 $r del x
2156 for {set i 0} {$i < 1000} {incr i} {
2157 set bin [randstring 0 10 $type]
2158 append buf $bin
2159 $r append x $bin
2160 }
2161 if {$buf != [$r get x]} {
2162 set err "Expected '$buf' found '[$r get x]'"
2163 break
2164 }
2165 }
2166 set _ $err
2167 } {}
2168
2169 test {SUBSTR basics} {
2170 set res {}
2171 $r set foo "Hello World"
2172 lappend res [$r substr foo 0 3]
2173 lappend res [$r substr foo 0 -1]
2174 lappend res [$r substr foo -4 -1]
2175 lappend res [$r substr foo 5 3]
2176 lappend res [$r substr foo 5 5000]
2177 lappend res [$r substr foo -5000 10000]
2178 set _ $res
2179 } {Hell {Hello World} orld {} { World} {Hello World}}
2180
2181 test {SUBSTR against integer encoded values} {
2182 $r set foo 123
2183 $r substr foo 0 -2
2184 } {12}
2185
2186 test {SUBSTR fuzzing} {
2187 set err {}
2188 for {set i 0} {$i < 1000} {incr i} {
2189 set bin [randstring 0 1024 binary]
2190 set _start [set start [randomInt 1500]]
2191 set _end [set end [randomInt 1500]]
2192 if {$_start < 0} {set _start "end-[abs($_start)-1]"}
2193 if {$_end < 0} {set _end "end-[abs($_end)-1]"}
2194 set s1 [string range $bin $_start $_end]
2195 $r set bin $bin
2196 set s2 [$r substr bin $start $end]
2197 if {$s1 != $s2} {
2198 set err "String mismatch"
2199 break
2200 }
2201 }
2202 set _ $err
2203 } {}
2204
2205 # Leave the user with a clean DB before to exit
2206 test {FLUSHDB} {
2207 set aux {}
2208 $r select 9
2209 $r flushdb
2210 lappend aux [$r dbsize]
2211 $r select 10
2212 $r flushdb
2213 lappend aux [$r dbsize]
2214 } {0 0}
2215
2216 test {Perform a final SAVE to leave a clean DB on disk} {
2217 $r save
2218 } {OK}
2219
2220 catch {
2221 if {[string match {*Darwin*} [exec uname -a]]} {
2222 test {Check for memory leaks} {
2223 exec leaks redis-server
2224 } {*0 leaks*}
2225 }
2226 }
2227
2228 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
2229 if {$::failed > 0} {
2230 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
2231 }
2232 }
2233
2234 proc stress {} {
2235 set r [redis $::host $::port]
2236 $r select 9
2237 $r flushdb
2238 while 1 {
2239 set randkey [expr int(rand()*10000)]
2240 set randval [expr int(rand()*10000)]
2241 set randidx0 [expr int(rand()*10)]
2242 set randidx1 [expr int(rand()*10)]
2243 set cmd [expr int(rand()*20)]
2244 catch {
2245 if {$cmd == 0} {$r set $randkey $randval}
2246 if {$cmd == 1} {$r get $randkey}
2247 if {$cmd == 2} {$r incr $randkey}
2248 if {$cmd == 3} {$r lpush $randkey $randval}
2249 if {$cmd == 4} {$r rpop $randkey}
2250 if {$cmd == 5} {$r del $randkey}
2251 if {$cmd == 6} {$r llen $randkey}
2252 if {$cmd == 7} {$r lrange $randkey $randidx0 $randidx1}
2253 if {$cmd == 8} {$r ltrim $randkey $randidx0 $randidx1}
2254 if {$cmd == 9} {$r lindex $randkey $randidx0}
2255 if {$cmd == 10} {$r lset $randkey $randidx0 $randval}
2256 if {$cmd == 11} {$r sadd $randkey $randval}
2257 if {$cmd == 12} {$r srem $randkey $randval}
2258 if {$cmd == 13} {$r smove $randkey $randval}
2259 if {$cmd == 14} {$r scard $randkey}
2260 if {$cmd == 15} {$r expire $randkey [expr $randval%60]}
2261 }
2262 flush stdout
2263 }
2264 $r flushdb
2265 $r close
2266 }
2267
2268 # Set a few configuration defaults
2269 set ::host 127.0.0.1
2270 set ::port 6379
2271 set ::stress 0
2272 set ::traceleaks 0
2273 set ::flush 0
2274 set ::first 0
2275 set ::last 1000000
2276
2277 # Parse arguments
2278 for {set j 0} {$j < [llength $argv]} {incr j} {
2279 set opt [lindex $argv $j]
2280 set arg [lindex $argv [expr $j+1]]
2281 set lastarg [expr {$arg eq {}}]
2282 if {$opt eq {-h} && !$lastarg} {
2283 set ::host $arg
2284 incr j
2285 } elseif {$opt eq {-p} && !$lastarg} {
2286 set ::port $arg
2287 incr j
2288 } elseif {$opt eq {--stress}} {
2289 set ::stress 1
2290 } elseif {$opt eq {--trace-leaks}} {
2291 set ::traceleaks 1
2292 } elseif {$opt eq {--flush}} {
2293 set ::flush 1
2294 } elseif {$opt eq {--first} && !$lastarg} {
2295 set ::first $arg
2296 incr j
2297 } elseif {$opt eq {--last} && !$lastarg} {
2298 set ::last $arg
2299 incr j
2300 } else {
2301 puts "Wrong argument: $opt"
2302 exit 1
2303 }
2304 }
2305
2306 # Before to run the test check if DB 9 and DB 10 are empty
2307 set r [redis $::host $::port]
2308
2309 if {$::flush} {
2310 $r flushall
2311 }
2312
2313 $r select 9
2314 set db9size [$r dbsize]
2315 $r select 10
2316 set db10size [$r dbsize]
2317 if {$db9size != 0 || $db10size != 0} {
2318 puts "Can't run the tests against DB 9 and 10: DBs are not empty."
2319 exit 1
2320 }
2321 $r close
2322 unset r
2323 unset db9size
2324 unset db10size
2325
2326 puts "Testing Redis, host $::host, port $::port"
2327 if {$::stress} {
2328 stress
2329 } else {
2330 main
2331 }