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