]> git.saurik.com Git - redis.git/blob - test-redis.tcl
design documents added to the project
[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
12 proc test {name code okpattern} {
13 puts -nonewline [format "%-70s " $name]
14 flush stdout
15 set retval [uplevel 1 $code]
16 if {$okpattern eq $retval || [string match $okpattern $retval]} {
17 puts "PASSED"
18 incr ::passed
19 } else {
20 puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'"
21 incr ::failed
22 }
23 }
24
25 proc randstring {min max {type binary}} {
26 set len [expr {$min+int(rand()*($max-$min+1))}]
27 set output {}
28 if {$type eq {binary}} {
29 set minval 0
30 set maxval 255
31 } elseif {$type eq {alpha}} {
32 set minval 48
33 set maxval 122
34 } elseif {$type eq {compr}} {
35 set minval 48
36 set maxval 52
37 }
38 while {$len} {
39 append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]]
40 incr len -1
41 }
42 return $output
43 }
44
45 # Useful for some test
46 proc zlistAlikeSort {a b} {
47 if {[lindex $a 0] > [lindex $b 0]} {return 1}
48 if {[lindex $a 0] < [lindex $b 0]} {return -1}
49 string compare [lindex $a 1] [lindex $b 1]
50 }
51
52 proc main {server port} {
53 set r [redis $server $port]
54 $r select 9
55 set err ""
56
57 # The following AUTH test should be enabled only when requirepass
58 # <PASSWORD> is set in redis.conf and redis-server was started with
59 # redis.conf as the first argument.
60
61 #test {AUTH with requirepass in redis.conf} {
62 # $r auth foobared
63 #} {OK}
64
65 test {DEL all keys to start with a clean DB} {
66 foreach key [$r keys *] {$r del $key}
67 $r dbsize
68 } {0}
69
70 test {SET and GET an item} {
71 $r set x foobar
72 $r get x
73 } {foobar}
74
75 test {DEL against a single item} {
76 $r del x
77 $r get x
78 } {}
79
80 test {Vararg DEL} {
81 $r set foo1 a
82 $r set foo2 b
83 $r set foo3 c
84 list [$r del foo1 foo2 foo3 foo4] [$r mget foo1 foo2 foo3]
85 } {3 {{} {} {}}}
86
87 test {KEYS with pattern} {
88 foreach key {key_x key_y key_z foo_a foo_b foo_c} {
89 $r set $key hello
90 }
91 lsort [$r keys foo*]
92 } {foo_a foo_b foo_c}
93
94 test {KEYS to get all keys} {
95 lsort [$r keys *]
96 } {foo_a foo_b foo_c key_x key_y key_z}
97
98 test {DBSIZE} {
99 $r dbsize
100 } {6}
101
102 test {DEL all keys} {
103 foreach key [$r keys *] {$r del $key}
104 $r dbsize
105 } {0}
106
107 test {Very big payload in GET/SET} {
108 set buf [string repeat "abcd" 1000000]
109 $r set foo $buf
110 $r get foo
111 } [string repeat "abcd" 1000000]
112
113 test {SET 10000 numeric keys and access all them in reverse order} {
114 for {set x 0} {$x < 10000} {incr x} {
115 $r set $x $x
116 }
117 set sum 0
118 for {set x 9999} {$x >= 0} {incr x -1} {
119 incr sum [$r get $x]
120 }
121 format $sum
122 } {49995000}
123
124 test {DBSIZE should be 10001 now} {
125 $r dbsize
126 } {10001}
127
128 test {INCR against non existing key} {
129 set res {}
130 append res [$r incr novar]
131 append res [$r get novar]
132 } {11}
133
134 test {INCR against key created by incr itself} {
135 $r incr novar
136 } {2}
137
138 test {INCR against key originally set with SET} {
139 $r set novar 100
140 $r incr novar
141 } {101}
142
143 test {INCR over 32bit value} {
144 $r set novar 17179869184
145 $r incr novar
146 } {17179869185}
147
148 test {INCRBY over 32bit value with over 32bit increment} {
149 $r set novar 17179869184
150 $r incrby novar 17179869184
151 } {34359738368}
152
153 test {DECRBY over 32bit value with over 32bit increment, negative res} {
154 $r set novar 17179869184
155 $r decrby novar 17179869185
156 } {-1}
157
158 test {SETNX target key missing} {
159 $r setnx novar2 foobared
160 $r get novar2
161 } {foobared}
162
163 test {SETNX target key exists} {
164 $r setnx novar2 blabla
165 $r get novar2
166 } {foobared}
167
168 test {EXISTS} {
169 set res {}
170 $r set newkey test
171 append res [$r exists newkey]
172 $r del newkey
173 append res [$r exists newkey]
174 } {10}
175
176 test {Zero length value in key. SET/GET/EXISTS} {
177 $r set emptykey {}
178 set res [$r get emptykey]
179 append res [$r exists emptykey]
180 $r del emptykey
181 append res [$r exists emptykey]
182 } {10}
183
184 test {Commands pipelining} {
185 set fd [$r channel]
186 puts -nonewline $fd "SET k1 4\r\nxyzk\r\nGET k1\r\nPING\r\n"
187 flush $fd
188 set res {}
189 append res [string match OK* [::redis::redis_read_reply $fd]]
190 append res [::redis::redis_read_reply $fd]
191 append res [string match PONG* [::redis::redis_read_reply $fd]]
192 format $res
193 } {1xyzk1}
194
195 test {Non existing command} {
196 catch {$r foobaredcommand} err
197 string match ERR* $err
198 } {1}
199
200 test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
201 $r lpush mylist a
202 $r lpush mylist b
203 $r rpush mylist c
204 set res [$r llen mylist]
205 append res [$r lindex mylist 0]
206 append res [$r lindex mylist 1]
207 append res [$r lindex mylist 2]
208 } {3bac}
209
210 test {DEL a list} {
211 $r del mylist
212 $r exists mylist
213 } {0}
214
215 test {Create a long list and check every single element with LINDEX} {
216 set ok 0
217 for {set i 0} {$i < 1000} {incr i} {
218 $r rpush mylist $i
219 }
220 for {set i 0} {$i < 1000} {incr i} {
221 if {[$r lindex mylist $i] eq $i} {incr ok}
222 if {[$r lindex mylist [expr (-$i)-1]] eq [expr 999-$i]} {
223 incr ok
224 }
225 }
226 format $ok
227 } {2000}
228
229 test {Test elements with LINDEX in random access} {
230 set ok 0
231 for {set i 0} {$i < 1000} {incr i} {
232 set rint [expr int(rand()*1000)]
233 if {[$r lindex mylist $rint] eq $rint} {incr ok}
234 if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
235 incr ok
236 }
237 }
238 format $ok
239 } {2000}
240
241 test {Check if the list is still ok after a DEBUG RELOAD} {
242 $r debug reload
243 set ok 0
244 for {set i 0} {$i < 1000} {incr i} {
245 set rint [expr int(rand()*1000)]
246 if {[$r lindex mylist $rint] eq $rint} {incr ok}
247 if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
248 incr ok
249 }
250 }
251 format $ok
252 } {2000}
253
254 test {LLEN against non-list value error} {
255 $r del mylist
256 $r set mylist foobar
257 catch {$r llen mylist} err
258 format $err
259 } {ERR*}
260
261 test {LINDEX against non-list value error} {
262 catch {$r lindex mylist 0} err
263 format $err
264 } {ERR*}
265
266 test {LPUSH against non-list value error} {
267 catch {$r lpush mylist 0} err
268 format $err
269 } {ERR*}
270
271 test {RPUSH against non-list value error} {
272 catch {$r rpush mylist 0} err
273 format $err
274 } {ERR*}
275
276 test {RPOPLPUSH base case} {
277 $r del mylist
278 $r rpush mylist a
279 $r rpush mylist b
280 $r rpush mylist c
281 $r rpush mylist d
282 set v1 [$r rpoplpush mylist newlist]
283 set v2 [$r rpoplpush mylist newlist]
284 set l1 [$r lrange mylist 0 -1]
285 set l2 [$r lrange newlist 0 -1]
286 list $v1 $v2 $l1 $l2
287 } {d c {a b} {c d}}
288
289 test {RPOPLPUSH with the same list as src and dst} {
290 $r del mylist
291 $r rpush mylist a
292 $r rpush mylist b
293 $r rpush mylist c
294 set l1 [$r lrange mylist 0 -1]
295 set v [$r rpoplpush mylist mylist]
296 set l2 [$r lrange mylist 0 -1]
297 list $l1 $v $l2
298 } {{a b c} c {c a b}}
299
300 test {RPOPLPUSH target list already exists} {
301 $r del mylist
302 $r del newlist
303 $r rpush mylist a
304 $r rpush mylist b
305 $r rpush mylist c
306 $r rpush mylist d
307 $r rpush newlist x
308 set v1 [$r rpoplpush mylist newlist]
309 set v2 [$r rpoplpush mylist newlist]
310 set l1 [$r lrange mylist 0 -1]
311 set l2 [$r lrange newlist 0 -1]
312 list $v1 $v2 $l1 $l2
313 } {d c {a b} {c d x}}
314
315 test {RPOPLPUSH against non existing key} {
316 $r del mylist
317 $r del newlist
318 set v1 [$r rpoplpush mylist newlist]
319 list $v1 [$r exists mylist] [$r exists newlist]
320 } {{} 0 0}
321
322 test {RPOPLPUSH against non list src key} {
323 $r del mylist
324 $r del newlist
325 $r set mylist x
326 catch {$r rpoplpush mylist newlist} err
327 list [$r type mylist] [$r exists newlist] [string range $err 0 2]
328 } {string 0 ERR}
329
330 test {RPOPLPUSH against non list dst key} {
331 $r del mylist
332 $r del newlist
333 $r rpush mylist a
334 $r rpush mylist b
335 $r rpush mylist c
336 $r rpush mylist d
337 $r set newlist x
338 catch {$r rpoplpush mylist newlist} err
339 list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2]
340 } {{a b c d} string ERR}
341
342 test {RENAME basic usage} {
343 $r set mykey hello
344 $r rename mykey mykey1
345 $r rename mykey1 mykey2
346 $r get mykey2
347 } {hello}
348
349 test {RENAME source key should no longer exist} {
350 $r exists mykey
351 } {0}
352
353 test {RENAME against already existing key} {
354 $r set mykey a
355 $r set mykey2 b
356 $r rename mykey2 mykey
357 set res [$r get mykey]
358 append res [$r exists mykey2]
359 } {b0}
360
361 test {RENAMENX basic usage} {
362 $r del mykey
363 $r del mykey2
364 $r set mykey foobar
365 $r renamenx mykey mykey2
366 set res [$r get mykey2]
367 append res [$r exists mykey]
368 } {foobar0}
369
370 test {RENAMENX against already existing key} {
371 $r set mykey foo
372 $r set mykey2 bar
373 $r renamenx mykey mykey2
374 } {0}
375
376 test {RENAMENX against already existing key (2)} {
377 set res [$r get mykey]
378 append res [$r get mykey2]
379 } {foobar}
380
381 test {RENAME against non existing source key} {
382 catch {$r rename nokey foobar} err
383 format $err
384 } {ERR*}
385
386 test {RENAME where source and dest key is the same} {
387 catch {$r rename mykey mykey} err
388 format $err
389 } {ERR*}
390
391 test {DEL all keys again (DB 0)} {
392 foreach key [$r keys *] {
393 $r del $key
394 }
395 $r dbsize
396 } {0}
397
398 test {DEL all keys again (DB 1)} {
399 $r select 10
400 foreach key [$r keys *] {
401 $r del $key
402 }
403 set res [$r dbsize]
404 $r select 9
405 format $res
406 } {0}
407
408 test {MOVE basic usage} {
409 $r set mykey foobar
410 $r move mykey 10
411 set res {}
412 lappend res [$r exists mykey]
413 lappend res [$r dbsize]
414 $r select 10
415 lappend res [$r get mykey]
416 lappend res [$r dbsize]
417 $r select 9
418 format $res
419 } [list 0 0 foobar 1]
420
421 test {MOVE against key existing in the target DB} {
422 $r set mykey hello
423 $r move mykey 10
424 } {0}
425
426 test {SET/GET keys in different DBs} {
427 $r set a hello
428 $r set b world
429 $r select 10
430 $r set a foo
431 $r set b bared
432 $r select 9
433 set res {}
434 lappend res [$r get a]
435 lappend res [$r get b]
436 $r select 10
437 lappend res [$r get a]
438 lappend res [$r get b]
439 $r select 9
440 format $res
441 } {hello world foo bared}
442
443 test {Basic LPOP/RPOP} {
444 $r del mylist
445 $r rpush mylist 1
446 $r rpush mylist 2
447 $r lpush mylist 0
448 list [$r lpop mylist] [$r rpop mylist] [$r lpop mylist] [$r llen mylist]
449 } [list 0 2 1 0]
450
451 test {LPOP/RPOP against empty list} {
452 $r lpop mylist
453 } {}
454
455 test {LPOP against non list value} {
456 $r set notalist foo
457 catch {$r lpop notalist} err
458 format $err
459 } {ERR*kind*}
460
461 test {Mass LPUSH/LPOP} {
462 set sum 0
463 for {set i 0} {$i < 1000} {incr i} {
464 $r lpush mylist $i
465 incr sum $i
466 }
467 set sum2 0
468 for {set i 0} {$i < 500} {incr i} {
469 incr sum2 [$r lpop mylist]
470 incr sum2 [$r rpop mylist]
471 }
472 expr $sum == $sum2
473 } {1}
474
475 test {LRANGE basics} {
476 for {set i 0} {$i < 10} {incr i} {
477 $r rpush mylist $i
478 }
479 list [$r lrange mylist 1 -2] \
480 [$r lrange mylist -3 -1] \
481 [$r lrange mylist 4 4]
482 } {{1 2 3 4 5 6 7 8} {7 8 9} 4}
483
484 test {LRANGE inverted indexes} {
485 $r lrange mylist 6 2
486 } {}
487
488 test {LRANGE out of range indexes including the full list} {
489 $r lrange mylist -1000 1000
490 } {0 1 2 3 4 5 6 7 8 9}
491
492 test {LRANGE against non existing key} {
493 $r lrange nosuchkey 0 1
494 } {}
495
496 test {LTRIM basics} {
497 $r del mylist
498 for {set i 0} {$i < 100} {incr i} {
499 $r lpush mylist $i
500 $r ltrim mylist 0 4
501 }
502 $r lrange mylist 0 -1
503 } {99 98 97 96 95}
504
505 test {LSET} {
506 $r lset mylist 1 foo
507 $r lset mylist -1 bar
508 $r lrange mylist 0 -1
509 } {99 foo 97 96 bar}
510
511 test {LSET out of range index} {
512 catch {$r lset mylist 10 foo} err
513 format $err
514 } {ERR*range*}
515
516 test {LSET against non existing key} {
517 catch {$r lset nosuchkey 10 foo} err
518 format $err
519 } {ERR*key*}
520
521 test {LSET against non list value} {
522 $r set nolist foobar
523 catch {$r lset nolist 0 foo} err
524 format $err
525 } {ERR*value*}
526
527 test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
528 $r sadd myset foo
529 $r sadd myset bar
530 list [$r scard myset] [$r sismember myset foo] \
531 [$r sismember myset bar] [$r sismember myset bla] \
532 [lsort [$r smembers myset]]
533 } {2 1 1 0 {bar foo}}
534
535 test {SADD adding the same element multiple times} {
536 $r sadd myset foo
537 $r sadd myset foo
538 $r sadd myset foo
539 $r scard myset
540 } {2}
541
542 test {SADD against non set} {
543 catch {$r sadd mylist foo} err
544 format $err
545 } {ERR*kind*}
546
547 test {SREM basics} {
548 $r sadd myset ciao
549 $r srem myset foo
550 lsort [$r smembers myset]
551 } {bar ciao}
552
553 test {Mass SADD and SINTER with two sets} {
554 for {set i 0} {$i < 1000} {incr i} {
555 $r sadd set1 $i
556 $r sadd set2 [expr $i+995]
557 }
558 lsort [$r sinter set1 set2]
559 } {995 996 997 998 999}
560
561 test {SUNION with two sets} {
562 lsort [$r sunion set1 set2]
563 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
564
565 test {SINTERSTORE with two sets} {
566 $r sinterstore setres set1 set2
567 lsort [$r smembers setres]
568 } {995 996 997 998 999}
569
570 test {SINTERSTORE with two sets, after a DEBUG RELOAD} {
571 $r debug reload
572 $r sinterstore setres set1 set2
573 lsort [$r smembers setres]
574 } {995 996 997 998 999}
575
576 test {SUNIONSTORE with two sets} {
577 $r sunionstore setres set1 set2
578 lsort [$r smembers setres]
579 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
580
581 test {SINTER against three sets} {
582 $r sadd set3 999
583 $r sadd set3 995
584 $r sadd set3 1000
585 $r sadd set3 2000
586 lsort [$r sinter set1 set2 set3]
587 } {995 999}
588
589 test {SINTERSTORE with three sets} {
590 $r sinterstore setres set1 set2 set3
591 lsort [$r smembers setres]
592 } {995 999}
593
594 test {SUNION with non existing keys} {
595 lsort [$r sunion nokey1 set1 set2 nokey2]
596 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
597
598 test {SDIFF with two sets} {
599 for {set i 5} {$i < 1000} {incr i} {
600 $r sadd set4 $i
601 }
602 lsort [$r sdiff set1 set4]
603 } {0 1 2 3 4}
604
605 test {SDIFF with three sets} {
606 $r sadd set5 0
607 lsort [$r sdiff set1 set4 set5]
608 } {1 2 3 4}
609
610 test {SDIFFSTORE with three sets} {
611 $r sdiffstore sres set1 set4 set5
612 lsort [$r smembers sres]
613 } {1 2 3 4}
614
615 test {SPOP basics} {
616 $r del myset
617 $r sadd myset 1
618 $r sadd myset 2
619 $r sadd myset 3
620 list [lsort [list [$r spop myset] [$r spop myset] [$r spop myset]]] [$r scard myset]
621 } {{1 2 3} 0}
622
623 test {SAVE - make sure there are all the types as values} {
624 # Wait for a background saving in progress to terminate
625 while 1 {
626 set i [$r info]
627 if {[string match {*bgsave_in_progress:1*} $i]} {
628 puts -nonewline "\nWaiting for background save to finish... "
629 flush stdout
630 after 100
631 } else {
632 break
633 }
634 }
635 $r lpush mysavelist hello
636 $r lpush mysavelist world
637 $r set myemptykey {}
638 $r set mynormalkey {blablablba}
639 $r zadd mytestzset a 10
640 $r zadd mytestzset b 20
641 $r zadd mytestzset c 30
642 $r save
643 } {OK}
644
645 test {SRANDMEMBER} {
646 $r del myset
647 $r sadd myset a
648 $r sadd myset b
649 $r sadd myset c
650 unset -nocomplain myset
651 array set myset {}
652 for {set i 0} {$i < 100} {incr i} {
653 set myset([$r srandmember myset]) 1
654 }
655 lsort [array names myset]
656 } {a b c}
657
658 test {Create a random list} {
659 set tosort {}
660 array set seenrand {}
661 for {set i 0} {$i < 10000} {incr i} {
662 while 1 {
663 # Make sure all the weights are different because
664 # Redis does not use a stable sort but Tcl does.
665 set rint [expr int(rand()*1000000)]
666 if {![info exists seenrand($rint)]} break
667 }
668 set seenrand($rint) x
669 $r lpush tosort $i
670 $r set weight_$i $rint
671 lappend tosort [list $i $rint]
672 }
673 set sorted [lsort -index 1 -real $tosort]
674 set res {}
675 for {set i 0} {$i < 10000} {incr i} {
676 lappend res [lindex $sorted $i 0]
677 }
678 format {}
679 } {}
680
681 test {SORT with BY against the newly created list} {
682 $r sort tosort {BY weight_*}
683 } $res
684
685 test {SORT direct, numeric, against the newly created list} {
686 $r sort tosort
687 } [lsort -integer $res]
688
689 test {SORT decreasing sort} {
690 $r sort tosort {DESC}
691 } [lsort -decreasing -integer $res]
692
693 test {SORT speed, sorting 10000 elements list using BY, 100 times} {
694 set start [clock clicks -milliseconds]
695 for {set i 0} {$i < 100} {incr i} {
696 set sorted [$r sort tosort {BY weight_* LIMIT 0 10}]
697 }
698 set elapsed [expr [clock clicks -milliseconds]-$start]
699 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
700 flush stdout
701 format {}
702 } {}
703
704 test {SORT speed, sorting 10000 elements list directly, 100 times} {
705 set start [clock clicks -milliseconds]
706 for {set i 0} {$i < 100} {incr i} {
707 set sorted [$r sort tosort {LIMIT 0 10}]
708 }
709 set elapsed [expr [clock clicks -milliseconds]-$start]
710 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
711 flush stdout
712 format {}
713 } {}
714
715 test {SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times} {
716 set start [clock clicks -milliseconds]
717 for {set i 0} {$i < 100} {incr i} {
718 set sorted [$r sort tosort {BY nokey LIMIT 0 10}]
719 }
720 set elapsed [expr [clock clicks -milliseconds]-$start]
721 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
722 flush stdout
723 format {}
724 } {}
725
726 test {SORT regression for issue #19, sorting floats} {
727 $r flushdb
728 foreach x {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15} {
729 $r lpush mylist $x
730 }
731 $r sort mylist
732 } [lsort -real {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}]
733
734 test {SORT with GET #} {
735 $r del mylist
736 $r lpush mylist 1
737 $r lpush mylist 2
738 $r lpush mylist 3
739 $r mset weight_1 10 weight_2 5 weight_3 30
740 $r sort mylist BY weight_* GET #
741 } {2 1 3}
742
743 test {LREM, remove all the occurrences} {
744 $r flushdb
745 $r rpush mylist foo
746 $r rpush mylist bar
747 $r rpush mylist foobar
748 $r rpush mylist foobared
749 $r rpush mylist zap
750 $r rpush mylist bar
751 $r rpush mylist test
752 $r rpush mylist foo
753 set res [$r lrem mylist 0 bar]
754 list [$r lrange mylist 0 -1] $res
755 } {{foo foobar foobared zap test foo} 2}
756
757 test {LREM, remove the first occurrence} {
758 set res [$r lrem mylist 1 foo]
759 list [$r lrange mylist 0 -1] $res
760 } {{foobar foobared zap test foo} 1}
761
762 test {LREM, remove non existing element} {
763 set res [$r lrem mylist 1 nosuchelement]
764 list [$r lrange mylist 0 -1] $res
765 } {{foobar foobared zap test foo} 0}
766
767 test {LREM, starting from tail with negative count} {
768 $r flushdb
769 $r rpush mylist foo
770 $r rpush mylist bar
771 $r rpush mylist foobar
772 $r rpush mylist foobared
773 $r rpush mylist zap
774 $r rpush mylist bar
775 $r rpush mylist test
776 $r rpush mylist foo
777 $r rpush mylist foo
778 set res [$r lrem mylist -1 bar]
779 list [$r lrange mylist 0 -1] $res
780 } {{foo bar foobar foobared zap test foo foo} 1}
781
782 test {LREM, starting from tail with negative count (2)} {
783 set res [$r lrem mylist -2 foo]
784 list [$r lrange mylist 0 -1] $res
785 } {{foo bar foobar foobared zap test} 2}
786
787 test {LREM, deleting objects that may be encoded as integers} {
788 $r lpush myotherlist 1
789 $r lpush myotherlist 2
790 $r lpush myotherlist 3
791 $r lrem myotherlist 1 2
792 $r llen myotherlist
793 } {2}
794
795 test {MGET} {
796 $r flushdb
797 $r set foo BAR
798 $r set bar FOO
799 $r mget foo bar
800 } {BAR FOO}
801
802 test {MGET against non existing key} {
803 $r mget foo baazz bar
804 } {BAR {} FOO}
805
806 test {MGET against non-string key} {
807 $r sadd myset ciao
808 $r sadd myset bau
809 $r mget foo baazz bar myset
810 } {BAR {} FOO {}}
811
812 test {RANDOMKEY} {
813 $r flushdb
814 $r set foo x
815 $r set bar y
816 set foo_seen 0
817 set bar_seen 0
818 for {set i 0} {$i < 100} {incr i} {
819 set rkey [$r randomkey]
820 if {$rkey eq {foo}} {
821 set foo_seen 1
822 }
823 if {$rkey eq {bar}} {
824 set bar_seen 1
825 }
826 }
827 list $foo_seen $bar_seen
828 } {1 1}
829
830 test {RANDOMKEY against empty DB} {
831 $r flushdb
832 $r randomkey
833 } {}
834
835 test {RANDOMKEY regression 1} {
836 $r flushdb
837 $r set x 10
838 $r del x
839 $r randomkey
840 } {}
841
842 test {GETSET (set new value)} {
843 list [$r getset foo xyz] [$r get foo]
844 } {{} xyz}
845
846 test {GETSET (replace old value)} {
847 $r set foo bar
848 list [$r getset foo xyz] [$r get foo]
849 } {bar xyz}
850
851 test {SMOVE basics} {
852 $r sadd myset1 a
853 $r sadd myset1 b
854 $r sadd myset1 c
855 $r sadd myset2 x
856 $r sadd myset2 y
857 $r sadd myset2 z
858 $r smove myset1 myset2 a
859 list [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
860 } {{a x y z} {b c}}
861
862 test {SMOVE non existing key} {
863 list [$r smove myset1 myset2 foo] [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
864 } {0 {a x y z} {b c}}
865
866 test {SMOVE non existing src set} {
867 list [$r smove noset myset2 foo] [lsort [$r smembers myset2]]
868 } {0 {a x y z}}
869
870 test {SMOVE non existing dst set} {
871 list [$r smove myset2 myset3 y] [lsort [$r smembers myset2]] [lsort [$r smembers myset3]]
872 } {1 {a x z} y}
873
874 test {SMOVE wrong src key type} {
875 $r set x 10
876 catch {$r smove x myset2 foo} err
877 format $err
878 } {ERR*}
879
880 test {SMOVE wrong dst key type} {
881 $r set x 10
882 catch {$r smove myset2 x foo} err
883 format $err
884 } {ERR*}
885
886 test {MSET base case} {
887 $r mset x 10 y "foo bar" z "x x x x x x x\n\n\r\n"
888 $r mget x y z
889 } [list 10 {foo bar} "x x x x x x x\n\n\r\n"]
890
891 test {MSET wrong number of args} {
892 catch {$r mset x 10 y "foo bar" z} err
893 format $err
894 } {*wrong number*}
895
896 test {MSETNX with already existent key} {
897 list [$r msetnx x1 xxx y2 yyy x 20] [$r exists x1] [$r exists y2]
898 } {0 0 0}
899
900 test {MSETNX with not existing keys} {
901 list [$r msetnx x1 xxx y2 yyy] [$r get x1] [$r get y2]
902 } {1 xxx yyy}
903
904 test {ZSET basic ZADD and score update} {
905 $r zadd ztmp 10 x
906 $r zadd ztmp 20 y
907 $r zadd ztmp 30 z
908 set aux1 [$r zrange ztmp 0 -1]
909 $r zadd ztmp 1 y
910 set aux2 [$r zrange ztmp 0 -1]
911 list $aux1 $aux2
912 } {{x y z} {y x z}}
913
914 test {ZSCORE} {
915 set aux {}
916 set err {}
917 for {set i 0} {$i < 1000} {incr i} {
918 set score [expr rand()]
919 lappend aux $score
920 $r zadd zscoretest $score $i
921 }
922 for {set i 0} {$i < 1000} {incr i} {
923 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
924 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
925 break
926 }
927 }
928 set _ $err
929 } {}
930
931 test {ZSCORE after a DEBUG RELOAD} {
932 set aux {}
933 set err {}
934 $r del zscoretest
935 for {set i 0} {$i < 1000} {incr i} {
936 set score [expr rand()]
937 lappend aux $score
938 $r zadd zscoretest $score $i
939 }
940 $r debug reload
941 for {set i 0} {$i < 1000} {incr i} {
942 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
943 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
944 break
945 }
946 }
947 set _ $err
948 } {}
949
950 test {ZRANGE and ZREVRANGE} {
951 list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1]
952 } {{y x z} {z x y}}
953
954 test {ZSETs stress tester - sorting is working well?} {
955 set delta 0
956 for {set test 0} {$test < 2} {incr test} {
957 unset -nocomplain auxarray
958 array set auxarray {}
959 set auxlist {}
960 $r del myzset
961 for {set i 0} {$i < 1000} {incr i} {
962 if {$test == 0} {
963 set score [expr rand()]
964 } else {
965 set score [expr int(rand()*10)]
966 }
967 set auxarray($i) $score
968 $r zadd myzset $score $i
969 # Random update
970 if {[expr rand()] < .2} {
971 set j [expr int(rand()*1000)]
972 if {$test == 0} {
973 set score [expr rand()]
974 } else {
975 set score [expr int(rand()*10)]
976 }
977 set auxarray($j) $score
978 $r zadd myzset $score $j
979 }
980 }
981 foreach {item score} [array get auxarray] {
982 lappend auxlist [list $score $item]
983 }
984 set sorted [lsort -command zlistAlikeSort $auxlist]
985 set auxlist {}
986 foreach x $sorted {
987 lappend auxlist [lindex $x 1]
988 }
989 set fromredis [$r zrange myzset 0 -1]
990 set delta 0
991 for {set i 0} {$i < [llength $fromredis]} {incr i} {
992 if {[lindex $fromredis $i] != [lindex $auxlist $i]} {
993 incr delta
994 }
995 }
996 }
997 format $delta
998 } {0}
999
1000 test {ZINCRBY - can create a new sorted set} {
1001 $r del zset
1002 $r zincrby zset 1 foo
1003 list [$r zrange zset 0 -1] [$r zscore zset foo]
1004 } {foo 1}
1005
1006 test {ZINCRBY - increment and decrement} {
1007 $r zincrby zset 2 foo
1008 $r zincrby zset 1 bar
1009 set v1 [$r zrange zset 0 -1]
1010 $r zincrby zset 10 bar
1011 $r zincrby zset -5 foo
1012 $r zincrby zset -5 bar
1013 set v2 [$r zrange zset 0 -1]
1014 list $v1 $v2 [$r zscore zset foo] [$r zscore zset bar]
1015 } {{bar foo} {foo bar} -2 6}
1016
1017 test {ZRANGEBYSCORE basics} {
1018 $r del zset
1019 $r zadd zset 1 a
1020 $r zadd zset 2 b
1021 $r zadd zset 3 c
1022 $r zadd zset 4 d
1023 $r zadd zset 5 e
1024 $r zrangebyscore zset 2 4
1025 } {b c d}
1026
1027 test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
1028 set err {}
1029 $r del zset
1030 for {set i 0} {$i < 1000} {incr i} {
1031 $r zadd zset [expr rand()] $i
1032 }
1033 for {set i 0} {$i < 100} {incr i} {
1034 set min [expr rand()]
1035 set max [expr rand()]
1036 if {$min > $max} {
1037 set aux $min
1038 set min $max
1039 set max $aux
1040 }
1041 set low [$r zrangebyscore zset -inf $min]
1042 set ok [$r zrangebyscore zset $min $max]
1043 set high [$r zrangebyscore zset $max +inf]
1044 foreach x $low {
1045 set score [$r zscore zset $x]
1046 if {$score > $min} {
1047 append err "Error, score for $x is $score > $min\n"
1048 }
1049 }
1050 foreach x $ok {
1051 set score [$r zscore zset $x]
1052 if {$score < $min || $score > $max} {
1053 append err "Error, score for $x is $score outside $min-$max range\n"
1054 }
1055 }
1056 foreach x $high {
1057 set score [$r zscore zset $x]
1058 if {$score < $max} {
1059 append err "Error, score for $x is $score < $max\n"
1060 }
1061 }
1062 }
1063 set _ $err
1064 } {}
1065
1066 test {ZRANGEBYSCORE with LIMIT} {
1067 $r del zset
1068 $r zadd zset 1 a
1069 $r zadd zset 2 b
1070 $r zadd zset 3 c
1071 $r zadd zset 4 d
1072 $r zadd zset 5 e
1073 list \
1074 [$r zrangebyscore zset 0 10 LIMIT 0 2] \
1075 [$r zrangebyscore zset 0 10 LIMIT 2 3] \
1076 [$r zrangebyscore zset 0 10 LIMIT 2 10] \
1077 [$r zrangebyscore zset 0 10 LIMIT 20 10]
1078 } {{a b} {c d e} {c d e} {}}
1079
1080 test {ZREMRANGE basics} {
1081 $r del zset
1082 $r zadd zset 1 a
1083 $r zadd zset 2 b
1084 $r zadd zset 3 c
1085 $r zadd zset 4 d
1086 $r zadd zset 5 e
1087 list [$r zremrangebyscore zset 2 4] [$r zrange zset 0 -1]
1088 } {3 {a e}}
1089
1090 test {ZREMRANGE from -inf to +inf} {
1091 $r del zset
1092 $r zadd zset 1 a
1093 $r zadd zset 2 b
1094 $r zadd zset 3 c
1095 $r zadd zset 4 d
1096 $r zadd zset 5 e
1097 list [$r zremrangebyscore zset -inf +inf] [$r zrange zset 0 -1]
1098 } {5 {}}
1099
1100 test {SORT against sorted sets} {
1101 $r del zset
1102 $r zadd zset 1 a
1103 $r zadd zset 5 b
1104 $r zadd zset 2 c
1105 $r zadd zset 10 d
1106 $r zadd zset 3 e
1107 $r sort zset alpha desc
1108 } {e d c b a}
1109
1110 test {Sorted sets +inf and -inf handling} {
1111 $r del zset
1112 $r zadd zset -100 a
1113 $r zadd zset 200 b
1114 $r zadd zset -300 c
1115 $r zadd zset 1000000 d
1116 $r zadd zset +inf max
1117 $r zadd zset -inf min
1118 $r zrange zset 0 -1
1119 } {min c a b d max}
1120
1121 test {EXPIRE - don't set timeouts multiple times} {
1122 $r set x foobar
1123 set v1 [$r expire x 5]
1124 set v2 [$r ttl x]
1125 set v3 [$r expire x 10]
1126 set v4 [$r ttl x]
1127 list $v1 $v2 $v3 $v4
1128 } {1 5 0 5}
1129
1130 test {EXPIRE - It should be still possible to read 'x'} {
1131 $r get x
1132 } {foobar}
1133
1134 test {EXPIRE - After 6 seconds the key should no longer be here} {
1135 after 6000
1136 list [$r get x] [$r exists x]
1137 } {{} 0}
1138
1139 test {EXPIRE - Delete on write policy} {
1140 $r del x
1141 $r lpush x foo
1142 $r expire x 1000
1143 $r lpush x bar
1144 $r lrange x 0 -1
1145 } {bar}
1146
1147 test {EXPIREAT - Check for EXPIRE alike behavior} {
1148 $r del x
1149 $r set x foo
1150 $r expireat x [expr [clock seconds]+15]
1151 $r ttl x
1152 } {1[345]}
1153
1154 test {ZSETs skiplist implementation backlink consistency test} {
1155 set diff 0
1156 set elements 10000
1157 for {set j 0} {$j < $elements} {incr j} {
1158 $r zadd myzset [expr rand()] "Element-$j"
1159 $r zrem myzset "Element-[expr int(rand()*$elements)]"
1160 }
1161 set l1 [$r zrange myzset 0 -1]
1162 set l2 [$r zrevrange myzset 0 -1]
1163 for {set j 0} {$j < [llength $l1]} {incr j} {
1164 if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
1165 incr diff
1166 }
1167 }
1168 format $diff
1169 } {0}
1170
1171 foreach fuzztype {binary alpha compr} {
1172 test "FUZZ stresser with data model $fuzztype" {
1173 set err 0
1174 for {set i 0} {$i < 10000} {incr i} {
1175 set fuzz [randstring 0 512 $fuzztype]
1176 $r set foo $fuzz
1177 set got [$r get foo]
1178 if {$got ne $fuzz} {
1179 set err [list $fuzz $got]
1180 break
1181 }
1182 }
1183 set _ $err
1184 } {0}
1185 }
1186
1187 # Leave the user with a clean DB before to exit
1188 test {FLUSHDB} {
1189 set aux {}
1190 $r select 9
1191 $r flushdb
1192 lappend aux [$r dbsize]
1193 $r select 10
1194 $r flushdb
1195 lappend aux [$r dbsize]
1196 } {0 0}
1197
1198 test {Perform a final SAVE to leave a clean DB on disk} {
1199 $r save
1200 } {OK}
1201
1202 catch {
1203 if {[string match {*Darwin*} [exec uname -a]]} {
1204 test {Check for memory leaks} {
1205 exec leaks redis-server
1206 } {*0 leaks*}
1207 }
1208 }
1209
1210 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
1211 if {$::failed > 0} {
1212 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
1213 }
1214 close $fd
1215 }
1216
1217 proc stress {} {
1218 set r [redis]
1219 $r select 9
1220 $r flushdb
1221 while 1 {
1222 set randkey [expr int(rand()*10000)]
1223 set randval [expr int(rand()*10000)]
1224 set randidx0 [expr int(rand()*10)]
1225 set randidx1 [expr int(rand()*10)]
1226 set cmd [expr int(rand()*20)]
1227 catch {
1228 if {$cmd == 0} {$r set $randkey $randval}
1229 if {$cmd == 1} {$r get $randkey}
1230 if {$cmd == 2} {$r incr $randkey}
1231 if {$cmd == 3} {$r lpush $randkey $randval}
1232 if {$cmd == 4} {$r rpop $randkey}
1233 if {$cmd == 5} {$r del $randkey}
1234 if {$cmd == 6} {$r llen $randkey}
1235 if {$cmd == 7} {$r lrange $randkey $randidx0 $randidx1}
1236 if {$cmd == 8} {$r ltrim $randkey $randidx0 $randidx1}
1237 if {$cmd == 9} {$r lindex $randkey $randidx0}
1238 if {$cmd == 10} {$r lset $randkey $randidx0 $randval}
1239 if {$cmd == 11} {$r sadd $randkey $randval}
1240 if {$cmd == 12} {$r srem $randkey $randval}
1241 if {$cmd == 13} {$r smove $randkey $randval}
1242 if {$cmd == 14} {$r scard $randkey}
1243 if {$cmd == 15} {$r expire $randkey [expr $randval%60]}
1244 }
1245 flush stdout
1246 }
1247 $r flushdb
1248 $r close
1249 }
1250
1251 # Before to run the test check if DB 9 and DB 10 are empty
1252 set r [redis]
1253 $r select 9
1254 set db9size [$r dbsize]
1255 $r select 10
1256 set db10size [$r dbsize]
1257 if {$db9size != 0 || $db10size != 0} {
1258 puts "Can't run the tests against DB 9 and 10: DBs are not empty."
1259 exit 1
1260 }
1261 $r close
1262 unset r
1263 unset db9size
1264 unset db10size
1265
1266 if {[llength $argv] == 0} {
1267 main 127.0.0.1 6379
1268 } elseif {[llength $argv] == 1 && [lindex $argv 0] eq {stress}} {
1269 stress
1270 } else {
1271 main [lindex $argv 0] [lindex $argv 1]
1272 }