]> git.saurik.com Git - redis.git/blame - test-redis.tcl
Merge branch 'test_vm' of git://github.com/pietern/redis
[redis.git] / test-redis.tcl
CommitLineData
7a932b74 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.
ed9b544e 5
405b0a6a 6set tcl_precision 17
f89c3a35 7source redis.tcl
43c9dc7b 8
ed9b544e 9set ::passed 0
10set ::failed 0
fc77604c 11set ::testnum 0
ed9b544e 12
13proc test {name code okpattern} {
fc77604c 14 incr ::testnum
15 if {$::testnum < $::first || $::testnum > $::last} return
16 puts -nonewline [format "%-70s " "#$::testnum $name"]
ed9b544e 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 }
bc554569 26 if {$::traceleaks} {
27 if {![string match {*0 leaks*} [exec leaks redis-server]]} {
28 puts "--------- Test $::testnum LEAKED! --------"
29 exit 1
30 }
31 }
ed9b544e 32}
33
75398fbc 34proc 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
d7f43c08 54# Useful for some test
55proc 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
0d36ded0 61proc 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
e96e4fbf 74proc 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
e054afda 87proc randomInt {max} {
88 expr {int(rand()*$max)}
89}
90
91proc randpath args {
92 set path [expr {int(rand()*[llength $args])}]
93 uplevel 1 [lindex $args $path]
94}
95
96proc 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
114proc 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
131proc createComplexDataset {r ops} {
132 for {set j 0} {$j < $ops} {incr j} {
133 set k [randomKey]
2a1198b4 134 set f [randomValue]
e054afda 135 set v [randomValue]
ab9d4cb1 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 }
e054afda 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
2a1198b4 160 } {
161 $r hset $k $f $v
e054afda 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 }
2a1198b4 185 {hash} {
186 randpath {$r hset $k $f $v} \
12f72a71 187 {$r hdel $k $f}
2a1198b4 188 }
e054afda 189 }
190 }
191}
192
193proc datasetDigest r {
758b6d4c 194 $r debug digest
e054afda 195}
196
fb765a0a 197proc main {} {
198 set r [redis $::host $::port]
eea4baf7 199 $r select 9
43c9dc7b 200 set err ""
fc77604c 201 set res ""
ed9b544e 202
abcb223e
BH
203 # The following AUTH test should be enabled only when requirepass
204 # <PASSWORD> is set in redis.conf and redis-server was started with
e0a62c7f 205 # redis.conf as the first argument.
abcb223e
BH
206
207 #test {AUTH with requirepass in redis.conf} {
208 # $r auth foobared
209 #} {OK}
210
ed9b544e 211 test {DEL all keys to start with a clean DB} {
43c9dc7b 212 foreach key [$r keys *] {$r del $key}
213 $r dbsize
ed9b544e 214 } {0}
215
216 test {SET and GET an item} {
43c9dc7b 217 $r set x foobar
218 $r get x
ed9b544e 219 } {foobar}
220
7c49733c 221 test {SET and GET an empty item} {
222 $r set x {}
223 $r get x
224 } {}
225
ed9b544e 226 test {DEL against a single item} {
43c9dc7b 227 $r del x
228 $r get x
ed9b544e 229 } {}
230
cc582a77 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
ed9b544e 238 test {KEYS with pattern} {
239 foreach key {key_x key_y key_z foo_a foo_b foo_c} {
43c9dc7b 240 $r set $key hello
ed9b544e 241 }
43c9dc7b 242 lsort [$r keys foo*]
ed9b544e 243 } {foo_a foo_b foo_c}
244
245 test {KEYS to get all keys} {
43c9dc7b 246 lsort [$r keys *]
ed9b544e 247 } {foo_a foo_b foo_c key_x key_y key_z}
248
249 test {DBSIZE} {
43c9dc7b 250 $r dbsize
ed9b544e 251 } {6}
252
253 test {DEL all keys} {
43c9dc7b 254 foreach key [$r keys *] {$r del $key}
255 $r dbsize
ed9b544e 256 } {0}
257
258 test {Very big payload in GET/SET} {
259 set buf [string repeat "abcd" 1000000]
43c9dc7b 260 $r set foo $buf
261 $r get foo
ed9b544e 262 } [string repeat "abcd" 1000000]
263
72766462 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]]
054e426d 269 set buf [string repeat "pl-$j" $size]
72766462 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)} {
5f8e5d7c 277 set err "Values differ: I set '$payload($index)' but I read back '$buf'"
72766462 278 break
279 }
280 }
281 unset payload
282 set _ $err
283 } {}
284
ed9b544e 285 test {SET 10000 numeric keys and access all them in reverse order} {
25fd2cb2 286 set err {}
ed9b544e 287 for {set x 0} {$x < 10000} {incr x} {
43c9dc7b 288 $r set $x $x
ed9b544e 289 }
290 set sum 0
291 for {set x 9999} {$x >= 0} {incr x -1} {
25fd2cb2 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 }
ed9b544e 297 }
25fd2cb2 298 set _ $err
d663729a 299 } {}
ed9b544e 300
fefed597 301 test {DBSIZE should be 10101 now} {
43c9dc7b 302 $r dbsize
fefed597 303 } {10101}
ed9b544e 304
305 test {INCR against non existing key} {
306 set res {}
43c9dc7b 307 append res [$r incr novar]
308 append res [$r get novar]
ed9b544e 309 } {11}
310
311 test {INCR against key created by incr itself} {
43c9dc7b 312 $r incr novar
ed9b544e 313 } {2}
314
315 test {INCR against key originally set with SET} {
43c9dc7b 316 $r set novar 100
317 $r incr novar
ed9b544e 318 } {101}
319
d68ed120 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
bbe025e0 330 test {INCR fails against key with spaces (no integer encoded)} {
ab9d4cb1 331 $r set novar " 11 "
bbe025e0
AM
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
6485f293 338 catch {$r incr mylist} err
bbe025e0
AM
339 $r rpop mylist
340 format $err
341 } {ERR*}
ab9d4cb1 342
d68ed120 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
ed9b544e 348 test {SETNX target key missing} {
43c9dc7b 349 $r setnx novar2 foobared
350 $r get novar2
ed9b544e 351 } {foobared}
352
353 test {SETNX target key exists} {
43c9dc7b 354 $r setnx novar2 blabla
355 $r get novar2
ed9b544e 356 } {foobared}
357
5acdc75d 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
ed9b544e 365 test {EXISTS} {
366 set res {}
43c9dc7b 367 $r set newkey test
368 append res [$r exists newkey]
369 $r del newkey
370 append res [$r exists newkey]
ed9b544e 371 } {10}
372
373 test {Zero length value in key. SET/GET/EXISTS} {
43c9dc7b 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]
ed9b544e 379 } {10}
380
381 test {Commands pipelining} {
43c9dc7b 382 set fd [$r channel]
ed9b544e 383 puts -nonewline $fd "SET k1 4\r\nxyzk\r\nGET k1\r\nPING\r\n"
384 flush $fd
385 set res {}
43c9dc7b 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]]
ed9b544e 389 format $res
390 } {1xyzk1}
391
392 test {Non existing command} {
43c9dc7b 393 catch {$r foobaredcommand} err
394 string match ERR* $err
ed9b544e 395 } {1}
396
397 test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
520b5a33 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]
43c9dc7b 405 append res [$r lindex mylist 0]
406 append res [$r lindex mylist 1]
407 append res [$r lindex mylist 2]
520b5a33 408 append res [$r lindex anotherlist 0]
409 append res [$r lindex anotherlist 1]
ab9d4cb1 410 list $res [$r lindex mylist 100]
520b5a33 411 } {1233122baced {}}
ed9b544e 412
413 test {DEL a list} {
43c9dc7b 414 $r del mylist
415 $r exists mylist
ed9b544e 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} {
43c9dc7b 421 $r rpush mylist $i
ed9b544e 422 }
423 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 424 if {[$r lindex mylist $i] eq $i} {incr ok}
425 if {[$r lindex mylist [expr (-$i)-1]] eq [expr 999-$i]} {
ed9b544e 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} {
43c9dc7b 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]} {
ed9b544e 438 incr ok
439 }
440 }
441 format $ok
442 } {2000}
443
210e29f7 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
ed9b544e 457 test {LLEN against non-list value error} {
43c9dc7b 458 $r del mylist
459 $r set mylist foobar
460 catch {$r llen mylist} err
461 format $err
c937aa89 462 } {ERR*}
ed9b544e 463
ab9d4cb1 464 test {LLEN against non existing key} {
465 $r llen not-a-key
466 } {0}
467
ed9b544e 468 test {LINDEX against non-list value error} {
43c9dc7b 469 catch {$r lindex mylist 0} err
470 format $err
c937aa89 471 } {ERR*}
ed9b544e 472
ab9d4cb1 473 test {LINDEX against non existing key} {
474 $r lindex not-a-key 10
475 } {}
476
ed9b544e 477 test {LPUSH against non-list value error} {
43c9dc7b 478 catch {$r lpush mylist 0} err
479 format $err
c937aa89 480 } {ERR*}
ed9b544e 481
482 test {RPUSH against non-list value error} {
43c9dc7b 483 catch {$r rpush mylist 0} err
484 format $err
c937aa89 485 } {ERR*}
ed9b544e 486
c08f1734 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
b9bb7ba2 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
fdcaae84 553 test {RPOPLPUSH against non existing src key} {
554 $r del mylist
555 $r del newlist
556 $r rpoplpush mylist newlist
557 } {}
558
ed9b544e 559 test {RENAME basic usage} {
43c9dc7b 560 $r set mykey hello
561 $r rename mykey mykey1
562 $r rename mykey1 mykey2
563 $r get mykey2
ed9b544e 564 } {hello}
565
566 test {RENAME source key should no longer exist} {
43c9dc7b 567 $r exists mykey
ed9b544e 568 } {0}
569
570 test {RENAME against already existing key} {
43c9dc7b 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]
ed9b544e 576 } {b0}
577
578 test {RENAMENX basic usage} {
43c9dc7b 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]
ed9b544e 585 } {foobar0}
586
587 test {RENAMENX against already existing key} {
43c9dc7b 588 $r set mykey foo
589 $r set mykey2 bar
590 $r renamenx mykey mykey2
ed9b544e 591 } {0}
592
593 test {RENAMENX against already existing key (2)} {
43c9dc7b 594 set res [$r get mykey]
595 append res [$r get mykey2]
ed9b544e 596 } {foobar}
597
598 test {RENAME against non existing source key} {
43c9dc7b 599 catch {$r rename nokey foobar} err
600 format $err
c937aa89 601 } {ERR*}
ed9b544e 602
603 test {RENAME where source and dest key is the same} {
43c9dc7b 604 catch {$r rename mykey mykey} err
605 format $err
c937aa89 606 } {ERR*}
ed9b544e 607
608 test {DEL all keys again (DB 0)} {
43c9dc7b 609 foreach key [$r keys *] {
610 $r del $key
ed9b544e 611 }
43c9dc7b 612 $r dbsize
ed9b544e 613 } {0}
614
615 test {DEL all keys again (DB 1)} {
eea4baf7 616 $r select 10
43c9dc7b 617 foreach key [$r keys *] {
618 $r del $key
ed9b544e 619 }
43c9dc7b 620 set res [$r dbsize]
eea4baf7 621 $r select 9
ed9b544e 622 format $res
623 } {0}
624
625 test {MOVE basic usage} {
43c9dc7b 626 $r set mykey foobar
eea4baf7 627 $r move mykey 10
ed9b544e 628 set res {}
43c9dc7b 629 lappend res [$r exists mykey]
630 lappend res [$r dbsize]
eea4baf7 631 $r select 10
43c9dc7b 632 lappend res [$r get mykey]
633 lappend res [$r dbsize]
eea4baf7 634 $r select 9
ed9b544e 635 format $res
636 } [list 0 0 foobar 1]
637
638 test {MOVE against key existing in the target DB} {
43c9dc7b 639 $r set mykey hello
eea4baf7 640 $r move mykey 10
ed9b544e 641 } {0}
642
643 test {SET/GET keys in different DBs} {
43c9dc7b 644 $r set a hello
645 $r set b world
eea4baf7 646 $r select 10
43c9dc7b 647 $r set a foo
648 $r set b bared
eea4baf7 649 $r select 9
ed9b544e 650 set res {}
43c9dc7b 651 lappend res [$r get a]
652 lappend res [$r get b]
eea4baf7 653 $r select 10
43c9dc7b 654 lappend res [$r get a]
655 lappend res [$r get b]
eea4baf7 656 $r select 9
ed9b544e 657 format $res
658 } {hello world foo bared}
659
660 test {Basic LPOP/RPOP} {
43c9dc7b 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]
ed9b544e 666 } [list 0 2 1 0]
667
668 test {LPOP/RPOP against empty list} {
43c9dc7b 669 $r lpop mylist
ed9b544e 670 } {}
671
672 test {LPOP against non list value} {
43c9dc7b 673 $r set notalist foo
674 catch {$r lpop notalist} err
675 format $err
c937aa89 676 } {ERR*kind*}
ed9b544e 677
678 test {Mass LPUSH/LPOP} {
679 set sum 0
680 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 681 $r lpush mylist $i
ed9b544e 682 incr sum $i
683 }
684 set sum2 0
685 for {set i 0} {$i < 500} {incr i} {
43c9dc7b 686 incr sum2 [$r lpop mylist]
687 incr sum2 [$r rpop mylist]
ed9b544e 688 }
689 expr $sum == $sum2
690 } {1}
691
692 test {LRANGE basics} {
693 for {set i 0} {$i < 10} {incr i} {
43c9dc7b 694 $r rpush mylist $i
ed9b544e 695 }
43c9dc7b 696 list [$r lrange mylist 1 -2] \
697 [$r lrange mylist -3 -1] \
698 [$r lrange mylist 4 4]
ed9b544e 699 } {{1 2 3 4 5 6 7 8} {7 8 9} 4}
700
701 test {LRANGE inverted indexes} {
43c9dc7b 702 $r lrange mylist 6 2
ed9b544e 703 } {}
704
705 test {LRANGE out of range indexes including the full list} {
43c9dc7b 706 $r lrange mylist -1000 1000
ed9b544e 707 } {0 1 2 3 4 5 6 7 8 9}
708
709 test {LRANGE against non existing key} {
43c9dc7b 710 $r lrange nosuchkey 0 1
ed9b544e 711 } {}
712
713 test {LTRIM basics} {
43c9dc7b 714 $r del mylist
ed9b544e 715 for {set i 0} {$i < 100} {incr i} {
43c9dc7b 716 $r lpush mylist $i
717 $r ltrim mylist 0 4
ed9b544e 718 }
43c9dc7b 719 $r lrange mylist 0 -1
ed9b544e 720 } {99 98 97 96 95}
721
c632369b 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
ed9b544e 747 test {LSET} {
c632369b 748 $r del mylist
749 foreach x {99 98 97 96 95} {
750 $r rpush mylist $x
751 }
43c9dc7b 752 $r lset mylist 1 foo
753 $r lset mylist -1 bar
754 $r lrange mylist 0 -1
ed9b544e 755 } {99 foo 97 96 bar}
756
757 test {LSET out of range index} {
43c9dc7b 758 catch {$r lset mylist 10 foo} err
759 format $err
c937aa89 760 } {ERR*range*}
ed9b544e 761
762 test {LSET against non existing key} {
43c9dc7b 763 catch {$r lset nosuchkey 10 foo} err
764 format $err
c937aa89 765 } {ERR*key*}
ed9b544e 766
767 test {LSET against non list value} {
43c9dc7b 768 $r set nolist foobar
769 catch {$r lset nolist 0 foo} err
770 format $err
c937aa89 771 } {ERR*value*}
ed9b544e 772
773 test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
43c9dc7b 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]]
ed9b544e 779 } {2 1 1 0 {bar foo}}
780
781 test {SADD adding the same element multiple times} {
43c9dc7b 782 $r sadd myset foo
783 $r sadd myset foo
784 $r sadd myset foo
785 $r scard myset
ed9b544e 786 } {2}
787
788 test {SADD against non set} {
43c9dc7b 789 catch {$r sadd mylist foo} err
790 format $err
c937aa89 791 } {ERR*kind*}
ed9b544e 792
793 test {SREM basics} {
43c9dc7b 794 $r sadd myset ciao
795 $r srem myset foo
796 lsort [$r smembers myset]
ed9b544e 797 } {bar ciao}
798
799 test {Mass SADD and SINTER with two sets} {
800 for {set i 0} {$i < 1000} {incr i} {
43c9dc7b 801 $r sadd set1 $i
802 $r sadd set2 [expr $i+995]
ed9b544e 803 }
43c9dc7b 804 lsort [$r sinter set1 set2]
ed9b544e 805 } {995 996 997 998 999}
40d224a9 806
807 test {SUNION with two sets} {
808 lsort [$r sunion set1 set2]
809 } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
e0a62c7f 810
ed9b544e 811 test {SINTERSTORE with two sets} {
43c9dc7b 812 $r sinterstore setres set1 set2
813 lsort [$r smembers setres]
ed9b544e 814 } {995 996 997 998 999}
815
210e29f7 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
40d224a9 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
f4d9b3c6 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
ed9b544e 832 test {SINTER against three sets} {
43c9dc7b 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]
ed9b544e 838 } {995 999}
839
840 test {SINTERSTORE with three sets} {
43c9dc7b 841 $r sinterstore setres set1 set2 set3
842 lsort [$r smembers setres]
ed9b544e 843 } {995 999}
40d224a9 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
f4f56e1d 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
12fea928 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
ed9b544e 874 test {SAVE - make sure there are all the types as values} {
bbf44ecf 875 # Wait for a background saving in progress to terminate
0d36ded0 876 waitForBgsave $r
43c9dc7b 877 $r lpush mysavelist hello
878 $r lpush mysavelist world
879 $r set myemptykey {}
880 $r set mynormalkey {blablablba}
bbe025e0
AM
881 $r zadd mytestzset 10 a
882 $r zadd mytestzset 20 b
883 $r zadd mytestzset 30 c
43c9dc7b 884 $r save
c937aa89 885 } {OK}
6cbfd2b3 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}
e0a62c7f 899
08ee9b57 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
98e1bb81 909 test {Create a random list and a random set} {
ed9b544e 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.
98e1bb81 916 randpath {
917 set rint [expr int(rand()*1000000)]
918 } {
919 set rint [expr rand()]
920 }
43c9dc7b 921 if {![info exists seenrand($rint)]} break
ed9b544e 922 }
43c9dc7b 923 set seenrand($rint) x
924 $r lpush tosort $i
98e1bb81 925 $r sadd tosort-set $i
43c9dc7b 926 $r set weight_$i $rint
c4e83132 927 $r hset wobj_$i weight $rint
43c9dc7b 928 lappend tosort [list $i $rint]
ed9b544e 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} {
43c9dc7b 939 $r sort tosort {BY weight_*}
ed9b544e 940 } $res
941
c4e83132 942 test {SORT with BY (hash field) against the newly created list} {
943 $r sort tosort {BY wobj_*->weight}
944 } $res
945
4bfcbab8 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
c4e83132 964 test {SORT with BY, but against the newly created set} {
98e1bb81 965 $r sort tosort-set {BY weight_*}
966 } $res
967
c4e83132 968 test {SORT with BY (hash field), but against the newly created set} {
969 $r sort tosort-set {BY wobj_*->weight}
970 } $res
971
5384a2d8 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
c4e83132 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
ed9b544e 982 test {SORT direct, numeric, against the newly created list} {
43c9dc7b 983 $r sort tosort
ed9b544e 984 } [lsort -integer $res]
985
986 test {SORT decreasing sort} {
43c9dc7b 987 $r sort tosort {DESC}
ed9b544e 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} {
43c9dc7b 993 set sorted [$r sort tosort {BY weight_* LIMIT 0 10}]
ed9b544e 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 } {}
c8c72447 1000
c4e83132 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
ed9b544e 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} {
43c9dc7b 1015 set sorted [$r sort tosort {LIMIT 0 10}]
ed9b544e 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} {
43c9dc7b 1026 set sorted [$r sort tosort {BY nokey LIMIT 0 10}]
ed9b544e 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} {
43c9dc7b 1035 $r flushdb
ed9b544e 1036 foreach x {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15} {
43c9dc7b 1037 $r lpush mylist $x
ed9b544e 1038 }
43c9dc7b 1039 $r sort mylist
ed9b544e 1040 } [lsort -real {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}]
1041
28173a49 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
d922ae65 1051 test {SORT with constant GET} {
1052 $r sort mylist GET foo
1053 } {{} {} {}}
1054
ed9b544e 1055 test {LREM, remove all the occurrences} {
eea4baf7 1056 $r flushdb
43c9dc7b 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
ed9b544e 1067 } {{foo foobar foobared zap test foo} 2}
1068
1069 test {LREM, remove the first occurrence} {
43c9dc7b 1070 set res [$r lrem mylist 1 foo]
1071 list [$r lrange mylist 0 -1] $res
ed9b544e 1072 } {{foobar foobared zap test foo} 1}
1073
1074 test {LREM, remove non existing element} {
43c9dc7b 1075 set res [$r lrem mylist 1 nosuchelement]
1076 list [$r lrange mylist 0 -1] $res
ed9b544e 1077 } {{foobar foobared zap test foo} 0}
1078
1079 test {LREM, starting from tail with negative count} {
eea4baf7 1080 $r flushdb
43c9dc7b 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
ed9b544e 1092 } {{foo bar foobar foobared zap test foo foo} 1}
1093
1094 test {LREM, starting from tail with negative count (2)} {
43c9dc7b 1095 set res [$r lrem mylist -2 foo]
1096 list [$r lrange mylist 0 -1] $res
ed9b544e 1097 } {{foo bar foobar foobared zap test} 2}
1098
724a51b1 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
5b19bd72 1107 test {MGET} {
eea4baf7 1108 $r flushdb
43c9dc7b 1109 $r set foo BAR
1110 $r set bar FOO
1111 $r mget foo bar
5b19bd72 1112 } {BAR FOO}
1113
1114 test {MGET against non existing key} {
43c9dc7b 1115 $r mget foo baazz bar
5b19bd72 1116 } {BAR {} FOO}
1117
1118 test {MGET against non-string key} {
43c9dc7b 1119 $r sadd myset ciao
1120 $r sadd myset bau
1121 $r mget foo baazz bar myset
5b19bd72 1122 } {BAR {} FOO {}}
1123
ce7bef07 1124 test {RANDOMKEY} {
eea4baf7 1125 $r flushdb
ce7bef07 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} {
eea4baf7 1143 $r flushdb
ce7bef07 1144 $r randomkey
1145 } {}
1146
f5785ae9 1147 test {RANDOMKEY regression 1} {
eea4baf7 1148 $r flushdb
f5785ae9 1149 $r set x 10
1150 $r del x
1151 $r randomkey
1152 } {}
1153
7ac6d461 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
0eeb2a4b 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
f69f2cba 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
5acdc75d 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
d7f43c08 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
fc77604c 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
69d95c3e
PN
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
798d9e55
PN
1248 test {ZREVRANK basics} {
1249 list [$r zrevrank zranktmp x] [$r zrevrank zranktmp y] [$r zrevrank zranktmp z]
1250 } {2 1 0}
1251
69d95c3e
PN
1252 test {ZRANK - after deletion} {
1253 $r zrem zranktmp y
1254 list [$r zrank zranktmp x] [$r zrank zranktmp z]
1255 } {0 1}
1256
d7f43c08 1257 test {ZSCORE} {
eaa256ad 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 } {}
d7f43c08 1273
210e29f7 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
ac945e2d 1293 test {ZRANGE and ZREVRANGE basics} {
04c71068 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}}
d7f43c08 1297
81d45645 1298 test {ZRANGE WITHSCORES} {
1299 $r zrange ztmp 0 -1 withscores
1300 } {y 1 x 10 z 30}
1301
d7f43c08 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
28173a49 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
223a0591 1365 test {ZRANGEBYSCORE and ZCOUNT basics} {
c74e7c77 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
223a0591 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}
c74e7c77 1375
0500ef27
SH
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
5b1207c6 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]
223a0591 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
5b1207c6 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 }
223a0591 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 }
5b1207c6 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 }
223a0591 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 }
5b1207c6 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 }
223a0591 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 }
5b1207c6 1462 }
1463 set _ $err
1464 } {}
1465
0b13687c 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
0500ef27
SH
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
9212eafd 1490 test {ZREMRANGEBYSCORE basics} {
9c21a518 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
9212eafd 1500 test {ZREMRANGEBYSCORE from -inf to +inf} {
9c21a518 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
9212eafd
PN
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
8bca8773
PN
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
2830ca53 1525 test {ZUNION basics} {
b287c9bb
PN
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
2830ca53 1533 list [$r zunion zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
b287c9bb
PN
1534 } {4 {a 1 b 3 d 3 c 5}}
1535
2830ca53
PN
1536 test {ZUNION with weights} {
1537 list [$r zunion zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
b287c9bb
PN
1538 } {4 {a 2 b 7 d 9 c 12}}
1539
d2764cd6
PN
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
2830ca53
PN
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
d2764cd6
PN
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
0b13687c 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
c74e7c77 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
164ee595 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
d33278d1
PN
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
516977de 1652 test {HSET in update and insert mode} {
b1d9c91c 1653 set rv {}
1654 set k [lindex [array names smallhash *] 0]
516977de 1655 lappend rv [$r hset smallhash $k newval1]
11d9d1e3 1656 set smallhash($k) newval1
516977de 1657 lappend rv [$r hget smallhash $k]
b1d9c91c 1658 lappend rv [$r hset smallhash __foobar123__ newval]
1659 set k [lindex [array names bighash *] 0]
516977de 1660 lappend rv [$r hset bighash $k newval2]
11d9d1e3 1661 set bighash($k) newval2
516977de 1662 lappend rv [$r hget bighash $k]
b1d9c91c 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
516977de 1667 } {0 newval1 1 0 newval2 1 1 1}
b1d9c91c 1668
1f1c7695
PN
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
d33278d1
PN
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}
b1d9c91c 1717
09aeb579
PN
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
b1d9c91c 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
11d9d1e3 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]
a86f14b1 1798 unset smallhash($k)
11d9d1e3 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]
a86f14b1 1803 unset bighash($k)
11d9d1e3 1804 set _ $rv
1805 } {0 0 1 0 {} 1 0 {}}
1806
a86f14b1 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
11d9d1e3 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
01426b05
PN
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
946342c1
PN
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}
01426b05 1872
b1d9c91c 1873 # TODO:
b1d9c91c 1874 # Randomized test, small and big
1875 # .rdb / AOF consistency test should include hashes
1876
b9febaab 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
5446315f 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
526d00a5 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
d7f43c08 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
3589e1a7 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} {
67cac143 1968 set err "$ele RANK is wrong! ($rank != $index)"
3589e1a7 1969 break
1970 }
1971 }
1972 }
1973 set _ $err
1974 } {}
1975
75398fbc 1976 foreach fuzztype {binary alpha compr} {
1977 test "FUZZ stresser with data model $fuzztype" {
1978 set err 0
f69f2cba 1979 for {set i 0} {$i < 10000} {incr i} {
75398fbc 1980 set fuzz [randstring 0 512 $fuzztype]
1981 $r set foo $fuzz
1982 set got [$r get foo]
1983 if {$got ne $fuzz} {
f69f2cba 1984 set err [list $fuzz $got]
75398fbc 1985 break
1986 }
1987 }
f69f2cba 1988 set _ $err
75398fbc 1989 } {0}
1990 }
1991
0d36ded0 1992 test {BGSAVE} {
7c775e09 1993 waitForBgsave $r
0d36ded0 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
7c49733c 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
e054afda 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}
e96e4fbf 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}
e054afda 2065 }
2066
e96e4fbf 2067 test {EXPIRES after a reload (snapshot + append only file)} {
71c2b467 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]
e96e4fbf 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}
71c2b467 2081
483049a7 2082 test {PIPELINING stresser (also a regression for the old epoll bug)} {
fb765a0a 2083 set fd2 [socket $::host $::port]
483049a7 2084 fconfigure $fd2 -encoding binary -translation binary
0447be2e 2085 puts -nonewline $fd2 "SELECT 9\r\n"
2086 flush $fd2
2087 gets $fd2
483049a7 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
4409877e 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
18b6cb76
DJ
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
3c290b9b 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
3c5caedc 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
3c290b9b 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
3c5caedc 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
ed9b544e 2205 # Leave the user with a clean DB before to exit
eea4baf7 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}
ed9b544e 2215
c28b42ac 2216 test {Perform a final SAVE to leave a clean DB on disk} {
2217 $r save
2218 } {OK}
2219
17511391 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
ed9b544e 2228 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
2229 if {$::failed > 0} {
2230 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
2231 }
ed9b544e 2232}
2233
5a6948fb 2234proc stress {} {
fb765a0a 2235 set r [redis $::host $::port]
eea4baf7 2236 $r select 9
2237 $r flushdb
5a6948fb 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)]
12f9d551 2243 set cmd [expr int(rand()*20)]
43c9dc7b 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}
12f9d551 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]}
43c9dc7b 2261 }
5a6948fb 2262 flush stdout
2263 }
eea4baf7 2264 $r flushdb
43c9dc7b 2265 $r close
5a6948fb 2266}
2267
fc77604c 2268# Set a few configuration defaults
2269set ::host 127.0.0.1
2270set ::port 6379
2271set ::stress 0
bc554569 2272set ::traceleaks 0
fc77604c 2273set ::flush 0
2274set ::first 0
2275set ::last 1000000
2276
2277# Parse arguments
2278for {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
bc554569 2288 } elseif {$opt eq {--stress}} {
fc77604c 2289 set ::stress 1
bc554569 2290 } elseif {$opt eq {--trace-leaks}} {
2291 set ::traceleaks 1
fc77604c 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 {
7c49733c 2301 puts "Wrong argument: $opt"
fc77604c 2302 exit 1
2303 }
2304}
2305
eea4baf7 2306# Before to run the test check if DB 9 and DB 10 are empty
fb765a0a 2307set r [redis $::host $::port]
fc77604c 2308
2309if {$::flush} {
2310 $r flushall
2311}
2312
eea4baf7 2313$r select 9
2314set db9size [$r dbsize]
2315$r select 10
2316set db10size [$r dbsize]
2317if {$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
2322unset r
2323unset db9size
2324unset db10size
2325
fb765a0a 2326puts "Testing Redis, host $::host, port $::port"
fc77604c 2327if {$::stress} {
5a6948fb 2328 stress
ed9b544e 2329} else {
fb765a0a 2330 main
ed9b544e 2331}