331 lines
9.1 KiB
Tcl
331 lines
9.1 KiB
Tcl
start_server {tags {"scan"}} {
|
|
test "SCAN basic" {
|
|
r flushdb
|
|
r debug populate 1000
|
|
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
set keys [lsort -unique $keys]
|
|
assert_equal 1000 [llength $keys]
|
|
}
|
|
|
|
test "SCAN COUNT" {
|
|
r flushdb
|
|
r debug populate 1000
|
|
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur count 5]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
set keys [lsort -unique $keys]
|
|
assert_equal 1000 [llength $keys]
|
|
}
|
|
|
|
test "SCAN MATCH" {
|
|
r flushdb
|
|
r debug populate 1000
|
|
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur match "key:1??"]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
set keys [lsort -unique $keys]
|
|
assert_equal 100 [llength $keys]
|
|
}
|
|
|
|
test "SCAN TYPE" {
|
|
r flushdb
|
|
# populate only creates strings
|
|
r debug populate 1000
|
|
|
|
# Check non-strings are excluded
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur type "list"]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
assert_equal 0 [llength $keys]
|
|
|
|
# Check strings are included
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur type "string"]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
assert_equal 1000 [llength $keys]
|
|
|
|
# Check all three args work together
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur type "string" match "key:*" count 10]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
assert_equal 1000 [llength $keys]
|
|
}
|
|
|
|
foreach enc {intset hashtable} {
|
|
test "SSCAN with encoding $enc" {
|
|
# Create the Set
|
|
r del set
|
|
if {$enc eq {intset}} {
|
|
set prefix ""
|
|
} else {
|
|
set prefix "ele:"
|
|
}
|
|
set elements {}
|
|
for {set j 0} {$j < 100} {incr j} {
|
|
lappend elements ${prefix}${j}
|
|
}
|
|
r sadd set {*}$elements
|
|
|
|
# Verify that the encoding matches.
|
|
assert {[r object encoding set] eq $enc}
|
|
|
|
# Test SSCAN
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r sscan set $cur]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
set keys [lsort -unique $keys]
|
|
assert_equal 100 [llength $keys]
|
|
}
|
|
}
|
|
|
|
foreach enc {ziplist hashtable} {
|
|
test "HSCAN with encoding $enc" {
|
|
# Create the Hash
|
|
r del hash
|
|
if {$enc eq {ziplist}} {
|
|
set count 30
|
|
} else {
|
|
set count 1000
|
|
}
|
|
set elements {}
|
|
for {set j 0} {$j < $count} {incr j} {
|
|
lappend elements key:$j $j
|
|
}
|
|
r hmset hash {*}$elements
|
|
|
|
# Verify that the encoding matches.
|
|
assert {[r object encoding hash] eq $enc}
|
|
|
|
# Test HSCAN
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r hscan hash $cur]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
set keys2 {}
|
|
foreach {k v} $keys {
|
|
assert {$k eq "key:$v"}
|
|
lappend keys2 $k
|
|
}
|
|
|
|
set keys2 [lsort -unique $keys2]
|
|
assert_equal $count [llength $keys2]
|
|
}
|
|
}
|
|
|
|
foreach enc {ziplist skiplist} {
|
|
test "ZSCAN with encoding $enc" {
|
|
# Create the Sorted Set
|
|
r del zset
|
|
if {$enc eq {ziplist}} {
|
|
set count 30
|
|
} else {
|
|
set count 1000
|
|
}
|
|
set elements {}
|
|
for {set j 0} {$j < $count} {incr j} {
|
|
lappend elements $j key:$j
|
|
}
|
|
r zadd zset {*}$elements
|
|
|
|
# Verify that the encoding matches.
|
|
assert {[r object encoding zset] eq $enc}
|
|
|
|
# Test ZSCAN
|
|
set cur 0
|
|
set keys {}
|
|
while 1 {
|
|
set res [r zscan zset $cur]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
}
|
|
|
|
set keys2 {}
|
|
foreach {k v} $keys {
|
|
assert {$k eq "key:$v"}
|
|
lappend keys2 $k
|
|
}
|
|
|
|
set keys2 [lsort -unique $keys2]
|
|
assert_equal $count [llength $keys2]
|
|
}
|
|
}
|
|
|
|
test "SCAN guarantees check under write load" {
|
|
r flushdb
|
|
r debug populate 100
|
|
|
|
# We start scanning here, so keys from 0 to 99 should all be
|
|
# reported at the end of the iteration.
|
|
set keys {}
|
|
while 1 {
|
|
set res [r scan $cur]
|
|
set cur [lindex $res 0]
|
|
set k [lindex $res 1]
|
|
lappend keys {*}$k
|
|
if {$cur == 0} break
|
|
# Write 10 random keys at every SCAN iteration.
|
|
for {set j 0} {$j < 10} {incr j} {
|
|
r set addedkey:[randomInt 1000] foo
|
|
}
|
|
}
|
|
|
|
set keys2 {}
|
|
foreach k $keys {
|
|
if {[string length $k] > 6} continue
|
|
lappend keys2 $k
|
|
}
|
|
|
|
set keys2 [lsort -unique $keys2]
|
|
assert_equal 100 [llength $keys2]
|
|
}
|
|
|
|
test "SSCAN with integer encoded object (issue #1345)" {
|
|
set objects {1 a}
|
|
r del set
|
|
r sadd set {*}$objects
|
|
set res [r sscan set 0 MATCH *a* COUNT 100]
|
|
assert_equal [lsort -unique [lindex $res 1]] {a}
|
|
set res [r sscan set 0 MATCH *1* COUNT 100]
|
|
assert_equal [lsort -unique [lindex $res 1]] {1}
|
|
}
|
|
|
|
test "SSCAN with PATTERN" {
|
|
r del mykey
|
|
r sadd mykey foo fab fiz foobar 1 2 3 4
|
|
set res [r sscan mykey 0 MATCH foo* COUNT 10000]
|
|
lsort -unique [lindex $res 1]
|
|
} {foo foobar}
|
|
|
|
test "HSCAN with PATTERN" {
|
|
r del mykey
|
|
r hmset mykey foo 1 fab 2 fiz 3 foobar 10 1 a 2 b 3 c 4 d
|
|
set res [r hscan mykey 0 MATCH foo* COUNT 10000]
|
|
lsort -unique [lindex $res 1]
|
|
} {1 10 foo foobar}
|
|
|
|
test "ZSCAN with PATTERN" {
|
|
r del mykey
|
|
r zadd mykey 1 foo 2 fab 3 fiz 10 foobar
|
|
set res [r zscan mykey 0 MATCH foo* COUNT 10000]
|
|
lsort -unique [lindex $res 1]
|
|
}
|
|
|
|
test "ZSCAN scores: regression test for issue #2175" {
|
|
r del mykey
|
|
for {set j 0} {$j < 500} {incr j} {
|
|
r zadd mykey 9.8813129168249309e-323 $j
|
|
}
|
|
set res [lindex [r zscan mykey 0] 1]
|
|
set first_score [lindex $res 1]
|
|
assert {$first_score != 0}
|
|
}
|
|
|
|
test "SCAN regression test for issue #4906" {
|
|
for {set k 0} {$k < 100} {incr k} {
|
|
r del set
|
|
r sadd set x; # Make sure it's not intset encoded
|
|
set toremove {}
|
|
unset -nocomplain found
|
|
array set found {}
|
|
|
|
# Populate the set
|
|
set numele [expr {101+[randomInt 1000]}]
|
|
for {set j 0} {$j < $numele} {incr j} {
|
|
r sadd set $j
|
|
if {$j >= 100} {
|
|
lappend toremove $j
|
|
}
|
|
}
|
|
|
|
# Start scanning
|
|
set cursor 0
|
|
set iteration 0
|
|
set del_iteration [randomInt 10]
|
|
while {!($cursor == 0 && $iteration != 0)} {
|
|
lassign [r sscan set $cursor] cursor items
|
|
|
|
# Mark found items. We expect to find from 0 to 99 at the end
|
|
# since those elements will never be removed during the scanning.
|
|
foreach i $items {
|
|
set found($i) 1
|
|
}
|
|
incr iteration
|
|
# At some point remove most of the items to trigger the
|
|
# rehashing to a smaller hash table.
|
|
if {$iteration == $del_iteration} {
|
|
r srem set {*}$toremove
|
|
}
|
|
}
|
|
|
|
# Verify that SSCAN reported everything from 0 to 99
|
|
for {set j 0} {$j < 100} {incr j} {
|
|
if {![info exists found($j)]} {
|
|
fail "SSCAN element missing $j"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|