mirror of
https://codeberg.org/redict/redict.git
synced 2025-01-23 08:38:27 -05:00
00613bed06
Removing the fix about 50% of the times the test will not be able to pass cleanly. It's very hard to write a test that will always fail, or actually, it is possible but then it's likely that it will consistently pass if we change some random bit, so better to use randomization here.
286 lines
8.0 KiB
Tcl
286 lines
8.0 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]
|
|
}
|
|
|
|
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 {100+[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"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|