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