]> git.saurik.com Git - redis.git/blob - test-redis.tcl
can select db num
[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 {RENAME basic usage} {
261 $r set mykey hello
262 $r rename mykey mykey1
263 $r rename mykey1 mykey2
264 $r get mykey2
265 } {hello}
266
267 test {RENAME source key should no longer exist} {
268 $r exists mykey
269 } {0}
270
271 test {RENAME against already existing key} {
272 $r set mykey a
273 $r set mykey2 b
274 $r rename mykey2 mykey
275 set res [$r get mykey]
276 append res [$r exists mykey2]
277 } {b0}
278
279 test {RENAMENX basic usage} {
280 $r del mykey
281 $r del mykey2
282 $r set mykey foobar
283 $r renamenx mykey mykey2
284 set res [$r get mykey2]
285 append res [$r exists mykey]
286 } {foobar0}
287
288 test {RENAMENX against already existing key} {
289 $r set mykey foo
290 $r set mykey2 bar
291 $r renamenx mykey mykey2
292 } {0}
293
294 test {RENAMENX against already existing key (2)} {
295 set res [$r get mykey]
296 append res [$r get mykey2]
297 } {foobar}
298
299 test {RENAME against non existing source key} {
300 catch {$r rename nokey foobar} err
301 format $err
302 } {ERR*}
303
304 test {RENAME where source and dest key is the same} {
305 catch {$r rename mykey mykey} err
306 format $err
307 } {ERR*}
308
309 test {DEL all keys again (DB 0)} {
310 foreach key [$r keys *] {
311 $r del $key
312 }
313 $r dbsize
314 } {0}
315
316 test {DEL all keys again (DB 1)} {
317 $r select 10
318 foreach key [$r keys *] {
319 $r del $key
320 }
321 set res [$r dbsize]
322 $r select 9
323 format $res
324 } {0}
325
326 test {MOVE basic usage} {
327 $r set mykey foobar
328 $r move mykey 10
329 set res {}
330 lappend res [$r exists mykey]
331 lappend res [$r dbsize]
332 $r select 10
333 lappend res [$r get mykey]
334 lappend res [$r dbsize]
335 $r select 9
336 format $res
337 } [list 0 0 foobar 1]
338
339 test {MOVE against key existing in the target DB} {
340 $r set mykey hello
341 $r move mykey 10
342 } {0}
343
344 test {SET/GET keys in different DBs} {
345 $r set a hello
346 $r set b world
347 $r select 10
348 $r set a foo
349 $r set b bared
350 $r select 9
351 set res {}
352 lappend res [$r get a]
353 lappend res [$r get b]
354 $r select 10
355 lappend res [$r get a]
356 lappend res [$r get b]
357 $r select 9
358 format $res
359 } {hello world foo bared}
360
361 test {Basic LPOP/RPOP} {
362 $r del mylist
363 $r rpush mylist 1
364 $r rpush mylist 2
365 $r lpush mylist 0
366 list [$r lpop mylist] [$r rpop mylist] [$r lpop mylist] [$r llen mylist]
367 } [list 0 2 1 0]
368
369 test {LPOP/RPOP against empty list} {
370 $r lpop mylist
371 } {}
372
373 test {LPOP against non list value} {
374 $r set notalist foo
375 catch {$r lpop notalist} err
376 format $err
377 } {ERR*kind*}
378
379 test {Mass LPUSH/LPOP} {
380 set sum 0
381 for {set i 0} {$i < 1000} {incr i} {
382 $r lpush mylist $i
383 incr sum $i
384 }
385 set sum2 0
386 for {set i 0} {$i < 500} {incr i} {
387 incr sum2 [$r lpop mylist]
388 incr sum2 [$r rpop mylist]
389 }
390 expr $sum == $sum2
391 } {1}
392
393 test {LRANGE basics} {
394 for {set i 0} {$i < 10} {incr i} {
395 $r rpush mylist $i
396 }
397 list [$r lrange mylist 1 -2] \
398 [$r lrange mylist -3 -1] \
399 [$r lrange mylist 4 4]
400 } {{1 2 3 4 5 6 7 8} {7 8 9} 4}
401
402 test {LRANGE inverted indexes} {
403 $r lrange mylist 6 2
404 } {}
405
406 test {LRANGE out of range indexes including the full list} {
407 $r lrange mylist -1000 1000
408 } {0 1 2 3 4 5 6 7 8 9}
409
410 test {LRANGE against non existing key} {
411 $r lrange nosuchkey 0 1
412 } {}
413
414 test {LTRIM basics} {
415 $r del mylist
416 for {set i 0} {$i < 100} {incr i} {
417 $r lpush mylist $i
418 $r ltrim mylist 0 4
419 }
420 $r lrange mylist 0 -1
421 } {99 98 97 96 95}
422
423 test {LSET} {
424 $r lset mylist 1 foo
425 $r lset mylist -1 bar
426 $r lrange mylist 0 -1
427 } {99 foo 97 96 bar}
428
429 test {LSET out of range index} {
430 catch {$r lset mylist 10 foo} err
431 format $err
432 } {ERR*range*}
433
434 test {LSET against non existing key} {
435 catch {$r lset nosuchkey 10 foo} err
436 format $err
437 } {ERR*key*}
438
439 test {LSET against non list value} {
440 $r set nolist foobar
441 catch {$r lset nolist 0 foo} err
442 format $err
443 } {ERR*value*}
444
445 test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
446 $r sadd myset foo
447 $r sadd myset bar
448 list [$r scard myset] [$r sismember myset foo] \
449 [$r sismember myset bar] [$r sismember myset bla] \
450 [lsort [$r smembers myset]]
451 } {2 1 1 0 {bar foo}}
452
453 test {SADD adding the same element multiple times} {
454 $r sadd myset foo
455 $r sadd myset foo
456 $r sadd myset foo
457 $r scard myset
458 } {2}
459
460 test {SADD against non set} {
461 catch {$r sadd mylist foo} err
462 format $err
463 } {ERR*kind*}
464
465 test {SREM basics} {
466 $r sadd myset ciao
467 $r srem myset foo
468 lsort [$r smembers myset]
469 } {bar ciao}
470
471 test {Mass SADD and SINTER with two sets} {
472 for {set i 0} {$i < 1000} {incr i} {
473 $r sadd set1 $i
474 $r sadd set2 [expr $i+995]
475 }
476 lsort [$r sinter set1 set2]
477 } {995 996 997 998 999}
478
479 test {SUNION with two sets} {
480 lsort [$r sunion set1 set2]
481 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
482
483 test {SINTERSTORE with two sets} {
484 $r sinterstore setres set1 set2
485 lsort [$r smembers setres]
486 } {995 996 997 998 999}
487
488 test {SUNIONSTORE with two sets} {
489 $r sunionstore setres set1 set2
490 lsort [$r smembers setres]
491 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
492
493 test {SINTER against three sets} {
494 $r sadd set3 999
495 $r sadd set3 995
496 $r sadd set3 1000
497 $r sadd set3 2000
498 lsort [$r sinter set1 set2 set3]
499 } {995 999}
500
501 test {SINTERSTORE with three sets} {
502 $r sinterstore setres set1 set2 set3
503 lsort [$r smembers setres]
504 } {995 999}
505
506 test {SUNION with non existing keys} {
507 lsort [$r sunion nokey1 set1 set2 nokey2]
508 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
509
510 test {SDIFF with two sets} {
511 for {set i 5} {$i < 1000} {incr i} {
512 $r sadd set4 $i
513 }
514 lsort [$r sdiff set1 set4]
515 } {0 1 2 3 4}
516
517 test {SDIFF with three sets} {
518 $r sadd set5 0
519 lsort [$r sdiff set1 set4 set5]
520 } {1 2 3 4}
521
522 test {SDIFFSTORE with three sets} {
523 $r sdiffstore sres set1 set4 set5
524 lsort [$r smembers sres]
525 } {1 2 3 4}
526
527 test {SPOP basics} {
528 $r del myset
529 $r sadd myset 1
530 $r sadd myset 2
531 $r sadd myset 3
532 list [lsort [list [$r spop myset] [$r spop myset] [$r spop myset]]] [$r scard myset]
533 } {{1 2 3} 0}
534
535 test {SAVE - make sure there are all the types as values} {
536 $r lpush mysavelist hello
537 $r lpush mysavelist world
538 $r set myemptykey {}
539 $r set mynormalkey {blablablba}
540 $r zadd mytestzset a 10
541 $r zadd mytestzset b 20
542 $r zadd mytestzset c 30
543 $r save
544 } {OK}
545
546 test {Create a random list} {
547 set tosort {}
548 array set seenrand {}
549 for {set i 0} {$i < 10000} {incr i} {
550 while 1 {
551 # Make sure all the weights are different because
552 # Redis does not use a stable sort but Tcl does.
553 set rint [expr int(rand()*1000000)]
554 if {![info exists seenrand($rint)]} break
555 }
556 set seenrand($rint) x
557 $r lpush tosort $i
558 $r set weight_$i $rint
559 lappend tosort [list $i $rint]
560 }
561 set sorted [lsort -index 1 -real $tosort]
562 set res {}
563 for {set i 0} {$i < 10000} {incr i} {
564 lappend res [lindex $sorted $i 0]
565 }
566 format {}
567 } {}
568
569 test {SORT with BY against the newly created list} {
570 $r sort tosort {BY weight_*}
571 } $res
572
573 test {SORT direct, numeric, against the newly created list} {
574 $r sort tosort
575 } [lsort -integer $res]
576
577 test {SORT decreasing sort} {
578 $r sort tosort {DESC}
579 } [lsort -decreasing -integer $res]
580
581 test {SORT speed, sorting 10000 elements list using BY, 100 times} {
582 set start [clock clicks -milliseconds]
583 for {set i 0} {$i < 100} {incr i} {
584 set sorted [$r sort tosort {BY weight_* LIMIT 0 10}]
585 }
586 set elapsed [expr [clock clicks -milliseconds]-$start]
587 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
588 flush stdout
589 format {}
590 } {}
591
592 test {SORT speed, sorting 10000 elements list directly, 100 times} {
593 set start [clock clicks -milliseconds]
594 for {set i 0} {$i < 100} {incr i} {
595 set sorted [$r sort tosort {LIMIT 0 10}]
596 }
597 set elapsed [expr [clock clicks -milliseconds]-$start]
598 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
599 flush stdout
600 format {}
601 } {}
602
603 test {SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times} {
604 set start [clock clicks -milliseconds]
605 for {set i 0} {$i < 100} {incr i} {
606 set sorted [$r sort tosort {BY nokey LIMIT 0 10}]
607 }
608 set elapsed [expr [clock clicks -milliseconds]-$start]
609 puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
610 flush stdout
611 format {}
612 } {}
613
614 test {SORT regression for issue #19, sorting floats} {
615 $r flushdb
616 foreach x {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15} {
617 $r lpush mylist $x
618 }
619 $r sort mylist
620 } [lsort -real {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}]
621
622 test {LREM, remove all the occurrences} {
623 $r flushdb
624 $r rpush mylist foo
625 $r rpush mylist bar
626 $r rpush mylist foobar
627 $r rpush mylist foobared
628 $r rpush mylist zap
629 $r rpush mylist bar
630 $r rpush mylist test
631 $r rpush mylist foo
632 set res [$r lrem mylist 0 bar]
633 list [$r lrange mylist 0 -1] $res
634 } {{foo foobar foobared zap test foo} 2}
635
636 test {LREM, remove the first occurrence} {
637 set res [$r lrem mylist 1 foo]
638 list [$r lrange mylist 0 -1] $res
639 } {{foobar foobared zap test foo} 1}
640
641 test {LREM, remove non existing element} {
642 set res [$r lrem mylist 1 nosuchelement]
643 list [$r lrange mylist 0 -1] $res
644 } {{foobar foobared zap test foo} 0}
645
646 test {LREM, starting from tail with negative count} {
647 $r flushdb
648 $r rpush mylist foo
649 $r rpush mylist bar
650 $r rpush mylist foobar
651 $r rpush mylist foobared
652 $r rpush mylist zap
653 $r rpush mylist bar
654 $r rpush mylist test
655 $r rpush mylist foo
656 $r rpush mylist foo
657 set res [$r lrem mylist -1 bar]
658 list [$r lrange mylist 0 -1] $res
659 } {{foo bar foobar foobared zap test foo foo} 1}
660
661 test {LREM, starting from tail with negative count (2)} {
662 set res [$r lrem mylist -2 foo]
663 list [$r lrange mylist 0 -1] $res
664 } {{foo bar foobar foobared zap test} 2}
665
666 test {LREM, deleting objects that may be encoded as integers} {
667 $r lpush myotherlist 1
668 $r lpush myotherlist 2
669 $r lpush myotherlist 3
670 $r lrem myotherlist 1 2
671 $r llen myotherlist
672 } {2}
673
674 test {MGET} {
675 $r flushdb
676 $r set foo BAR
677 $r set bar FOO
678 $r mget foo bar
679 } {BAR FOO}
680
681 test {MGET against non existing key} {
682 $r mget foo baazz bar
683 } {BAR {} FOO}
684
685 test {MGET against non-string key} {
686 $r sadd myset ciao
687 $r sadd myset bau
688 $r mget foo baazz bar myset
689 } {BAR {} FOO {}}
690
691 test {RANDOMKEY} {
692 $r flushdb
693 $r set foo x
694 $r set bar y
695 set foo_seen 0
696 set bar_seen 0
697 for {set i 0} {$i < 100} {incr i} {
698 set rkey [$r randomkey]
699 if {$rkey eq {foo}} {
700 set foo_seen 1
701 }
702 if {$rkey eq {bar}} {
703 set bar_seen 1
704 }
705 }
706 list $foo_seen $bar_seen
707 } {1 1}
708
709 test {RANDOMKEY against empty DB} {
710 $r flushdb
711 $r randomkey
712 } {}
713
714 test {RANDOMKEY regression 1} {
715 $r flushdb
716 $r set x 10
717 $r del x
718 $r randomkey
719 } {}
720
721 test {GETSET (set new value)} {
722 list [$r getset foo xyz] [$r get foo]
723 } {{} xyz}
724
725 test {GETSET (replace old value)} {
726 $r set foo bar
727 list [$r getset foo xyz] [$r get foo]
728 } {bar xyz}
729
730 test {SMOVE basics} {
731 $r sadd myset1 a
732 $r sadd myset1 b
733 $r sadd myset1 c
734 $r sadd myset2 x
735 $r sadd myset2 y
736 $r sadd myset2 z
737 $r smove myset1 myset2 a
738 list [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
739 } {{a x y z} {b c}}
740
741 test {SMOVE non existing key} {
742 list [$r smove myset1 myset2 foo] [lsort [$r smembers myset2]] [lsort [$r smembers myset1]]
743 } {0 {a x y z} {b c}}
744
745 test {SMOVE non existing src set} {
746 list [$r smove noset myset2 foo] [lsort [$r smembers myset2]]
747 } {0 {a x y z}}
748
749 test {SMOVE non existing dst set} {
750 list [$r smove myset2 myset3 y] [lsort [$r smembers myset2]] [lsort [$r smembers myset3]]
751 } {1 {a x z} y}
752
753 test {SMOVE wrong src key type} {
754 $r set x 10
755 catch {$r smove x myset2 foo} err
756 format $err
757 } {ERR*}
758
759 test {SMOVE wrong dst key type} {
760 $r set x 10
761 catch {$r smove myset2 x foo} err
762 format $err
763 } {ERR*}
764
765 test {MSET base case} {
766 $r mset x 10 y "foo bar" z "x x x x x x x\n\n\r\n"
767 $r mget x y z
768 } [list 10 {foo bar} "x x x x x x x\n\n\r\n"]
769
770 test {MSET wrong number of args} {
771 catch {$r mset x 10 y "foo bar" z} err
772 format $err
773 } {*wrong number*}
774
775 test {MSETNX with already existent key} {
776 list [$r msetnx x1 xxx y2 yyy x 20] [$r exists x1] [$r exists y2]
777 } {0 0 0}
778
779 test {MSETNX with not existing keys} {
780 list [$r msetnx x1 xxx y2 yyy] [$r get x1] [$r get y2]
781 } {1 xxx yyy}
782
783 test {ZSET basic ZADD and score update} {
784 $r zadd ztmp 10 x
785 $r zadd ztmp 20 y
786 $r zadd ztmp 30 z
787 set aux1 [$r zrange ztmp 0 -1]
788 $r zadd ztmp 1 y
789 set aux2 [$r zrange ztmp 0 -1]
790 list $aux1 $aux2
791 } {{x y z} {y x z}}
792
793 test {ZSCORE} {
794 set aux {}
795 set err {}
796 for {set i 0} {$i < 1000} {incr i} {
797 set score [expr rand()]
798 lappend aux $score
799 $r zadd zscoretest $score $i
800 }
801 for {set i 0} {$i < 1000} {incr i} {
802 if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
803 set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
804 break
805 }
806 }
807 set _ $err
808 } {}
809
810 test {ZRANGE and ZREVRANGE} {
811 list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1]
812 } {{y x z} {z x y}}
813
814 test {ZSETs stress tester - sorting is working well?} {
815 set delta 0
816 for {set test 0} {$test < 2} {incr test} {
817 unset -nocomplain auxarray
818 array set auxarray {}
819 set auxlist {}
820 $r del myzset
821 for {set i 0} {$i < 1000} {incr i} {
822 if {$test == 0} {
823 set score [expr rand()]
824 } else {
825 set score [expr int(rand()*10)]
826 }
827 set auxarray($i) $score
828 $r zadd myzset $score $i
829 # Random update
830 if {[expr rand()] < .2} {
831 set j [expr int(rand()*1000)]
832 if {$test == 0} {
833 set score [expr rand()]
834 } else {
835 set score [expr int(rand()*10)]
836 }
837 set auxarray($j) $score
838 $r zadd myzset $score $j
839 }
840 }
841 foreach {item score} [array get auxarray] {
842 lappend auxlist [list $score $item]
843 }
844 set sorted [lsort -command zlistAlikeSort $auxlist]
845 set auxlist {}
846 foreach x $sorted {
847 lappend auxlist [lindex $x 1]
848 }
849 set fromredis [$r zrange myzset 0 -1]
850 set delta 0
851 for {set i 0} {$i < [llength $fromredis]} {incr i} {
852 if {[lindex $fromredis $i] != [lindex $auxlist $i]} {
853 incr delta
854 }
855 }
856 }
857 format $delta
858 } {0}
859
860 test {ZSETs skiplist implementation backlink consistency test} {
861 set diff 0
862 set elements 10000
863 for {set j 0} {$j < $elements} {incr j} {
864 $r zadd myzset [expr rand()] "Element-$j"
865 $r zrem myzset "Element-[expr int(rand()*$elements)]"
866 }
867 set l1 [$r zrange myzset 0 -1]
868 set l2 [$r zrevrange myzset 0 -1]
869 for {set j 0} {$j < [llength $l1]} {incr j} {
870 if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
871 incr diff
872 }
873 }
874 format $diff
875 } {0}
876
877 foreach fuzztype {binary alpha compr} {
878 test "FUZZ stresser with data model $fuzztype" {
879 set err 0
880 for {set i 0} {$i < 10000} {incr i} {
881 set fuzz [randstring 0 512 $fuzztype]
882 $r set foo $fuzz
883 set got [$r get foo]
884 if {$got ne $fuzz} {
885 set err [list $fuzz $got]
886 break
887 }
888 }
889 set _ $err
890 } {0}
891 }
892
893 # Leave the user with a clean DB before to exit
894 test {FLUSHDB} {
895 set aux {}
896 $r select 9
897 $r flushdb
898 lappend aux [$r dbsize]
899 $r select 10
900 $r flushdb
901 lappend aux [$r dbsize]
902 } {0 0}
903
904 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
905 if {$::failed > 0} {
906 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
907 }
908 close $fd
909 }
910
911 proc stress {} {
912 set r [redis]
913 $r select 9
914 $r flushdb
915 while 1 {
916 set randkey [expr int(rand()*10000)]
917 set randval [expr int(rand()*10000)]
918 set randidx0 [expr int(rand()*10)]
919 set randidx1 [expr int(rand()*10)]
920 set cmd [expr int(rand()*20)]
921 catch {
922 if {$cmd == 0} {$r set $randkey $randval}
923 if {$cmd == 1} {$r get $randkey}
924 if {$cmd == 2} {$r incr $randkey}
925 if {$cmd == 3} {$r lpush $randkey $randval}
926 if {$cmd == 4} {$r rpop $randkey}
927 if {$cmd == 5} {$r del $randkey}
928 if {$cmd == 6} {$r llen $randkey}
929 if {$cmd == 7} {$r lrange $randkey $randidx0 $randidx1}
930 if {$cmd == 8} {$r ltrim $randkey $randidx0 $randidx1}
931 if {$cmd == 9} {$r lindex $randkey $randidx0}
932 if {$cmd == 10} {$r lset $randkey $randidx0 $randval}
933 if {$cmd == 11} {$r sadd $randkey $randval}
934 if {$cmd == 12} {$r srem $randkey $randval}
935 if {$cmd == 13} {$r smove $randkey $randval}
936 if {$cmd == 14} {$r scard $randkey}
937 if {$cmd == 15} {$r expire $randkey [expr $randval%60]}
938 }
939 flush stdout
940 }
941 $r flushdb
942 $r close
943 }
944
945 # Before to run the test check if DB 9 and DB 10 are empty
946 set r [redis]
947 $r select 9
948 set db9size [$r dbsize]
949 $r select 10
950 set db10size [$r dbsize]
951 if {$db9size != 0 || $db10size != 0} {
952 puts "Can't run the tests against DB 9 and 10: DBs are not empty."
953 exit 1
954 }
955 $r close
956 unset r
957 unset db9size
958 unset db10size
959
960 if {[llength $argv] == 0} {
961 main 127.0.0.1 6379
962 } elseif {[llength $argv] == 1 && [lindex $argv 0] eq {stress}} {
963 stress
964 } else {
965 main [lindex $argv 0] [lindex $argv 1]
966 }