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