diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index 7e9e2cfaa..914f6ba1e 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -16,8 +16,10 @@ set ::all_tests { unit/dump unit/auth unit/protocol - unit/basic + unit/keyspace unit/scan + unit/type/string + unit/type/incr unit/type/list unit/type/list-2 unit/type/list-3 diff --git a/tests/unit/keyspace.tcl b/tests/unit/keyspace.tcl new file mode 100644 index 000000000..e808aaf98 --- /dev/null +++ b/tests/unit/keyspace.tcl @@ -0,0 +1,249 @@ +start_server {tags {"keyspace"}} { + test {DEL against a single item} { + r set x foo + assert {[r get x] eq "foo"} + r del x + r get x + } {} + + test {Vararg DEL} { + r set foo1 a + r set foo2 b + r set foo3 c + list [r del foo1 foo2 foo3 foo4] [r mget foo1 foo2 foo3] + } {3 {{} {} {}}} + + test {KEYS with pattern} { + foreach key {key_x key_y key_z foo_a foo_b foo_c} { + r set $key hello + } + lsort [r keys foo*] + } {foo_a foo_b foo_c} + + test {KEYS to get all keys} { + lsort [r keys *] + } {foo_a foo_b foo_c key_x key_y key_z} + + test {DBSIZE} { + r dbsize + } {6} + + test {DEL all keys} { + foreach key [r keys *] {r del $key} + r dbsize + } {0} + + test "DEL against expired key" { + r debug set-active-expire 0 + r setex keyExpire 1 valExpire + after 1100 + assert_equal 0 [r del keyExpire] + r debug set-active-expire 1 + } + + test {EXISTS} { + set res {} + r set newkey test + append res [r exists newkey] + r del newkey + append res [r exists newkey] + } {10} + + test {Zero length value in key. SET/GET/EXISTS} { + r set emptykey {} + set res [r get emptykey] + append res [r exists emptykey] + r del emptykey + append res [r exists emptykey] + } {10} + + test {Commands pipelining} { + set fd [r channel] + puts -nonewline $fd "SET k1 xyzk\r\nGET k1\r\nPING\r\n" + flush $fd + set res {} + append res [string match OK* [r read]] + append res [r read] + append res [string match PONG* [r read]] + format $res + } {1xyzk1} + + test {Non existing command} { + catch {r foobaredcommand} err + string match ERR* $err + } {1} + + test {RENAME basic usage} { + r set mykey hello + r rename mykey mykey1 + r rename mykey1 mykey2 + r get mykey2 + } {hello} + + test {RENAME source key should no longer exist} { + r exists mykey + } {0} + + test {RENAME against already existing key} { + r set mykey a + r set mykey2 b + r rename mykey2 mykey + set res [r get mykey] + append res [r exists mykey2] + } {b0} + + test {RENAMENX basic usage} { + r del mykey + r del mykey2 + r set mykey foobar + r renamenx mykey mykey2 + set res [r get mykey2] + append res [r exists mykey] + } {foobar0} + + test {RENAMENX against already existing key} { + r set mykey foo + r set mykey2 bar + r renamenx mykey mykey2 + } {0} + + test {RENAMENX against already existing key (2)} { + set res [r get mykey] + append res [r get mykey2] + } {foobar} + + test {RENAME against non existing source key} { + catch {r rename nokey foobar} err + format $err + } {ERR*} + + test {RENAME where source and dest key are the same (existing)} { + r set mykey foo + r rename mykey mykey + } {OK} + + test {RENAMENX where source and dest key are the same (existing)} { + r set mykey foo + r renamenx mykey mykey + } {0} + + test {RENAME where source and dest key are the same (non existing)} { + r del mykey + catch {r rename mykey mykey} err + format $err + } {ERR*} + + test {RENAME with volatile key, should move the TTL as well} { + r del mykey mykey2 + r set mykey foo + r expire mykey 100 + assert {[r ttl mykey] > 95 && [r ttl mykey] <= 100} + r rename mykey mykey2 + assert {[r ttl mykey2] > 95 && [r ttl mykey2] <= 100} + } + + test {RENAME with volatile key, should not inherit TTL of target key} { + r del mykey mykey2 + r set mykey foo + r set mykey2 bar + r expire mykey2 100 + assert {[r ttl mykey] == -1 && [r ttl mykey2] > 0} + r rename mykey mykey2 + r ttl mykey2 + } {-1} + + test {DEL all keys again (DB 0)} { + foreach key [r keys *] { + r del $key + } + r dbsize + } {0} + + test {DEL all keys again (DB 1)} { + r select 10 + foreach key [r keys *] { + r del $key + } + set res [r dbsize] + r select 9 + format $res + } {0} + + test {MOVE basic usage} { + r set mykey foobar + r move mykey 10 + set res {} + lappend res [r exists mykey] + lappend res [r dbsize] + r select 10 + lappend res [r get mykey] + lappend res [r dbsize] + r select 9 + format $res + } [list 0 0 foobar 1] + + test {MOVE against key existing in the target DB} { + r set mykey hello + r move mykey 10 + } {0} + + test {MOVE against non-integer DB (#1428)} { + r set mykey hello + catch {r move mykey notanumber} e + set e + } {*ERR*index out of range} + + test {SET/GET keys in different DBs} { + r set a hello + r set b world + r select 10 + r set a foo + r set b bared + r select 9 + set res {} + lappend res [r get a] + lappend res [r get b] + r select 10 + lappend res [r get a] + lappend res [r get b] + r select 9 + format $res + } {hello world foo bared} + + test {RANDOMKEY} { + r flushdb + r set foo x + r set bar y + set foo_seen 0 + set bar_seen 0 + for {set i 0} {$i < 100} {incr i} { + set rkey [r randomkey] + if {$rkey eq {foo}} { + set foo_seen 1 + } + if {$rkey eq {bar}} { + set bar_seen 1 + } + } + list $foo_seen $bar_seen + } {1 1} + + test {RANDOMKEY against empty DB} { + r flushdb + r randomkey + } {} + + test {RANDOMKEY regression 1} { + r flushdb + r set x 10 + r del x + r randomkey + } {} + + test {KEYS * two times with long key, Github issue #1208} { + r flushdb + r set dlskeriewrioeuwqoirueioqwrueoqwrueqw test + r keys * + r keys * + } {dlskeriewrioeuwqoirueioqwrueoqwrueqw} +} diff --git a/tests/unit/type/incr.tcl b/tests/unit/type/incr.tcl new file mode 100644 index 000000000..2287aaae2 --- /dev/null +++ b/tests/unit/type/incr.tcl @@ -0,0 +1,147 @@ +start_server {tags {"incr"}} { + test {INCR against non existing key} { + set res {} + append res [r incr novar] + append res [r get novar] + } {11} + + test {INCR against key created by incr itself} { + r incr novar + } {2} + + test {INCR against key originally set with SET} { + r set novar 100 + r incr novar + } {101} + + test {INCR over 32bit value} { + r set novar 17179869184 + r incr novar + } {17179869185} + + test {INCRBY over 32bit value with over 32bit increment} { + r set novar 17179869184 + r incrby novar 17179869184 + } {34359738368} + + test {INCR fails against key with spaces (left)} { + r set novar " 11" + catch {r incr novar} err + format $err + } {ERR*} + + test {INCR fails against key with spaces (right)} { + r set novar "11 " + catch {r incr novar} err + format $err + } {ERR*} + + test {INCR fails against key with spaces (both)} { + r set novar " 11 " + catch {r incr novar} err + format $err + } {ERR*} + + test {INCR fails against a key holding a list} { + r rpush mylist 1 + catch {r incr mylist} err + r rpop mylist + format $err + } {WRONGTYPE*} + + test {DECRBY over 32bit value with over 32bit increment, negative res} { + r set novar 17179869184 + r decrby novar 17179869185 + } {-1} + + test {INCR uses shared objects in the 0-9999 range} { + r set foo -1 + r incr foo + assert {[r object refcount foo] > 1} + r set foo 9998 + r incr foo + assert {[r object refcount foo] > 1} + r incr foo + assert {[r object refcount foo] == 1} + } + + test {INCR can modify objects in-place} { + r set foo 20000 + r incr foo + assert {[r object refcount foo] == 1} + set old [lindex [split [r debug object foo]] 1] + r incr foo + set new [lindex [split [r debug object foo]] 1] + assert {[string range $old 0 2] eq "at:"} + assert {[string range $new 0 2] eq "at:"} + assert {$old eq $new} + } + + test {INCRBYFLOAT against non existing key} { + r del novar + list [roundFloat [r incrbyfloat novar 1]] \ + [roundFloat [r get novar]] \ + [roundFloat [r incrbyfloat novar 0.25]] \ + [roundFloat [r get novar]] + } {1 1 1.25 1.25} + + test {INCRBYFLOAT against key originally set with SET} { + r set novar 1.5 + roundFloat [r incrbyfloat novar 1.5] + } {3} + + test {INCRBYFLOAT over 32bit value} { + r set novar 17179869184 + r incrbyfloat novar 1.5 + } {17179869185.5} + + test {INCRBYFLOAT over 32bit value with over 32bit increment} { + r set novar 17179869184 + r incrbyfloat novar 17179869184 + } {34359738368} + + test {INCRBYFLOAT fails against key with spaces (left)} { + set err {} + r set novar " 11" + catch {r incrbyfloat novar 1.0} err + format $err + } {ERR*valid*} + + test {INCRBYFLOAT fails against key with spaces (right)} { + set err {} + r set novar "11 " + catch {r incrbyfloat novar 1.0} err + format $err + } {ERR*valid*} + + test {INCRBYFLOAT fails against key with spaces (both)} { + set err {} + r set novar " 11 " + catch {r incrbyfloat novar 1.0} err + format $err + } {ERR*valid*} + + test {INCRBYFLOAT fails against a key holding a list} { + r del mylist + set err {} + r rpush mylist 1 + catch {r incrbyfloat mylist 1.0} err + r del mylist + format $err + } {WRONGTYPE*} + + test {INCRBYFLOAT does not allow NaN or Infinity} { + r set foo 0 + set err {} + catch {r incrbyfloat foo +inf} err + set err + # p.s. no way I can force NaN to test it from the API because + # there is no way to increment / decrement by infinity nor to + # perform divisions. + } {ERR*would produce*} + + test {INCRBYFLOAT decrement} { + r set foo 1 + roundFloat [r incrbyfloat foo -1.1] + } {-0.1} +} diff --git a/tests/unit/basic.tcl b/tests/unit/type/string.tcl similarity index 55% rename from tests/unit/basic.tcl rename to tests/unit/type/string.tcl index fec0df5ec..c98d56815 100644 --- a/tests/unit/basic.tcl +++ b/tests/unit/type/string.tcl @@ -1,9 +1,4 @@ -start_server {tags {"basic"}} { - test {DEL all keys to start with a clean DB} { - foreach key [r keys *] {r del $key} - r dbsize - } {0} - +start_server {tags {"string"}} { test {SET and GET an item} { r set x foobar r get x @@ -14,38 +9,6 @@ start_server {tags {"basic"}} { r get x } {} - test {DEL against a single item} { - r del x - r get x - } {} - - test {Vararg DEL} { - r set foo1 a - r set foo2 b - r set foo3 c - list [r del foo1 foo2 foo3 foo4] [r mget foo1 foo2 foo3] - } {3 {{} {} {}}} - - test {KEYS with pattern} { - foreach key {key_x key_y key_z foo_a foo_b foo_c} { - r set $key hello - } - lsort [r keys foo*] - } {foo_a foo_b foo_c} - - test {KEYS to get all keys} { - lsort [r keys *] - } {foo_a foo_b foo_c key_x key_y key_z} - - test {DBSIZE} { - r dbsize - } {6} - - test {DEL all keys} { - foreach key [r keys *] {r del $key} - r dbsize - } {0} - test {Very big payload in GET/SET} { set buf [string repeat "abcd" 1000000] r set foo $buf @@ -95,152 +58,6 @@ start_server {tags {"basic"}} { } {10101} } - test {INCR against non existing key} { - set res {} - append res [r incr novar] - append res [r get novar] - } {11} - - test {INCR against key created by incr itself} { - r incr novar - } {2} - - test {INCR against key originally set with SET} { - r set novar 100 - r incr novar - } {101} - - test {INCR over 32bit value} { - r set novar 17179869184 - r incr novar - } {17179869185} - - test {INCRBY over 32bit value with over 32bit increment} { - r set novar 17179869184 - r incrby novar 17179869184 - } {34359738368} - - test {INCR fails against key with spaces (left)} { - r set novar " 11" - catch {r incr novar} err - format $err - } {ERR*} - - test {INCR fails against key with spaces (right)} { - r set novar "11 " - catch {r incr novar} err - format $err - } {ERR*} - - test {INCR fails against key with spaces (both)} { - r set novar " 11 " - catch {r incr novar} err - format $err - } {ERR*} - - test {INCR fails against a key holding a list} { - r rpush mylist 1 - catch {r incr mylist} err - r rpop mylist - format $err - } {WRONGTYPE*} - - test {DECRBY over 32bit value with over 32bit increment, negative res} { - r set novar 17179869184 - r decrby novar 17179869185 - } {-1} - - test {INCR uses shared objects in the 0-9999 range} { - r set foo -1 - r incr foo - assert {[r object refcount foo] > 1} - r set foo 9998 - r incr foo - assert {[r object refcount foo] > 1} - r incr foo - assert {[r object refcount foo] == 1} - } - - test {INCR can modify objects in-place} { - r set foo 20000 - r incr foo - assert {[r object refcount foo] == 1} - set old [lindex [split [r debug object foo]] 1] - r incr foo - set new [lindex [split [r debug object foo]] 1] - assert {[string range $old 0 2] eq "at:"} - assert {[string range $new 0 2] eq "at:"} - assert {$old eq $new} - } - - test {INCRBYFLOAT against non existing key} { - r del novar - list [roundFloat [r incrbyfloat novar 1]] \ - [roundFloat [r get novar]] \ - [roundFloat [r incrbyfloat novar 0.25]] \ - [roundFloat [r get novar]] - } {1 1 1.25 1.25} - - test {INCRBYFLOAT against key originally set with SET} { - r set novar 1.5 - roundFloat [r incrbyfloat novar 1.5] - } {3} - - test {INCRBYFLOAT over 32bit value} { - r set novar 17179869184 - r incrbyfloat novar 1.5 - } {17179869185.5} - - test {INCRBYFLOAT over 32bit value with over 32bit increment} { - r set novar 17179869184 - r incrbyfloat novar 17179869184 - } {34359738368} - - test {INCRBYFLOAT fails against key with spaces (left)} { - set err {} - r set novar " 11" - catch {r incrbyfloat novar 1.0} err - format $err - } {ERR*valid*} - - test {INCRBYFLOAT fails against key with spaces (right)} { - set err {} - r set novar "11 " - catch {r incrbyfloat novar 1.0} err - format $err - } {ERR*valid*} - - test {INCRBYFLOAT fails against key with spaces (both)} { - set err {} - r set novar " 11 " - catch {r incrbyfloat novar 1.0} err - format $err - } {ERR*valid*} - - test {INCRBYFLOAT fails against a key holding a list} { - r del mylist - set err {} - r rpush mylist 1 - catch {r incrbyfloat mylist 1.0} err - r del mylist - format $err - } {WRONGTYPE*} - - test {INCRBYFLOAT does not allow NaN or Infinity} { - r set foo 0 - set err {} - catch {r incrbyfloat foo +inf} err - set err - # p.s. no way I can force NaN to test it from the API because - # there is no way to increment / decrement by infinity nor to - # perform divisions. - } {ERR*would produce*} - - test {INCRBYFLOAT decrement} { - r set foo 1 - roundFloat [r incrbyfloat foo -1.1] - } {-0.1} - test "SETNX target key missing" { r del novar assert_equal 1 [r setnx novar foobared] @@ -284,183 +101,6 @@ start_server {tags {"basic"}} { assert_equal 20 [r get x] } - test "DEL against expired key" { - r debug set-active-expire 0 - r setex keyExpire 1 valExpire - after 1100 - assert_equal 0 [r del keyExpire] - r debug set-active-expire 1 - } - - test {EXISTS} { - set res {} - r set newkey test - append res [r exists newkey] - r del newkey - append res [r exists newkey] - } {10} - - test {Zero length value in key. SET/GET/EXISTS} { - r set emptykey {} - set res [r get emptykey] - append res [r exists emptykey] - r del emptykey - append res [r exists emptykey] - } {10} - - test {Commands pipelining} { - set fd [r channel] - puts -nonewline $fd "SET k1 xyzk\r\nGET k1\r\nPING\r\n" - flush $fd - set res {} - append res [string match OK* [r read]] - append res [r read] - append res [string match PONG* [r read]] - format $res - } {1xyzk1} - - test {Non existing command} { - catch {r foobaredcommand} err - string match ERR* $err - } {1} - - test {RENAME basic usage} { - r set mykey hello - r rename mykey mykey1 - r rename mykey1 mykey2 - r get mykey2 - } {hello} - - test {RENAME source key should no longer exist} { - r exists mykey - } {0} - - test {RENAME against already existing key} { - r set mykey a - r set mykey2 b - r rename mykey2 mykey - set res [r get mykey] - append res [r exists mykey2] - } {b0} - - test {RENAMENX basic usage} { - r del mykey - r del mykey2 - r set mykey foobar - r renamenx mykey mykey2 - set res [r get mykey2] - append res [r exists mykey] - } {foobar0} - - test {RENAMENX against already existing key} { - r set mykey foo - r set mykey2 bar - r renamenx mykey mykey2 - } {0} - - test {RENAMENX against already existing key (2)} { - set res [r get mykey] - append res [r get mykey2] - } {foobar} - - test {RENAME against non existing source key} { - catch {r rename nokey foobar} err - format $err - } {ERR*} - - test {RENAME where source and dest key are the same (existing)} { - r set mykey foo - r rename mykey mykey - } {OK} - - test {RENAMENX where source and dest key are the same (existing)} { - r set mykey foo - r renamenx mykey mykey - } {0} - - test {RENAME where source and dest key are the same (non existing)} { - r del mykey - catch {r rename mykey mykey} err - format $err - } {ERR*} - - test {RENAME with volatile key, should move the TTL as well} { - r del mykey mykey2 - r set mykey foo - r expire mykey 100 - assert {[r ttl mykey] > 95 && [r ttl mykey] <= 100} - r rename mykey mykey2 - assert {[r ttl mykey2] > 95 && [r ttl mykey2] <= 100} - } - - test {RENAME with volatile key, should not inherit TTL of target key} { - r del mykey mykey2 - r set mykey foo - r set mykey2 bar - r expire mykey2 100 - assert {[r ttl mykey] == -1 && [r ttl mykey2] > 0} - r rename mykey mykey2 - r ttl mykey2 - } {-1} - - test {DEL all keys again (DB 0)} { - foreach key [r keys *] { - r del $key - } - r dbsize - } {0} - - test {DEL all keys again (DB 1)} { - r select 10 - foreach key [r keys *] { - r del $key - } - set res [r dbsize] - r select 9 - format $res - } {0} - - test {MOVE basic usage} { - r set mykey foobar - r move mykey 10 - set res {} - lappend res [r exists mykey] - lappend res [r dbsize] - r select 10 - lappend res [r get mykey] - lappend res [r dbsize] - r select 9 - format $res - } [list 0 0 foobar 1] - - test {MOVE against key existing in the target DB} { - r set mykey hello - r move mykey 10 - } {0} - - test {MOVE against non-integer DB (#1428)} { - r set mykey hello - catch {r move mykey notanumber} e - set e - } {*ERR*index out of range} - - test {SET/GET keys in different DBs} { - r set a hello - r set b world - r select 10 - r set a foo - r set b bared - r select 9 - set res {} - lappend res [r get a] - lappend res [r get b] - r select 10 - lappend res [r get a] - lappend res [r get b] - r select 9 - format $res - } {hello world foo bared} - test {MGET} { r flushdb r set foo BAR @@ -478,36 +118,6 @@ start_server {tags {"basic"}} { r mget foo baazz bar myset } {BAR {} FOO {}} - test {RANDOMKEY} { - r flushdb - r set foo x - r set bar y - set foo_seen 0 - set bar_seen 0 - for {set i 0} {$i < 100} {incr i} { - set rkey [r randomkey] - if {$rkey eq {foo}} { - set foo_seen 1 - } - if {$rkey eq {bar}} { - set bar_seen 1 - } - } - list $foo_seen $bar_seen - } {1 1} - - test {RANDOMKEY against empty DB} { - r flushdb - r randomkey - } {} - - test {RANDOMKEY regression 1} { - r flushdb - r set x 10 - r del x - r randomkey - } {} - test {GETSET (set new value)} { list [r getset foo xyz] [r get foo] } {{} xyz} @@ -803,13 +413,6 @@ start_server {tags {"basic"}} { assert {$ttl <= 10 && $ttl > 5} } - test {KEYS * two times with long key, Github issue #1208} { - r flushdb - r set dlskeriewrioeuwqoirueioqwrueoqwrueqw test - r keys * - r keys * - } {dlskeriewrioeuwqoirueioqwrueoqwrueqw} - test {GETRANGE with huge ranges, Github issue #1844} { r set foo bar r getrange foo 0 4294967297