From bb12c1fd00eb51118749bbbc69c5596835fcbd3b Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sat, 4 May 2024 19:31:02 +0200 Subject: Adding upstream version 5:7.0.15. Signed-off-by: Daniel Baumann --- tests/unit/scan.tcl | 330 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 330 insertions(+) create mode 100644 tests/unit/scan.tcl (limited to 'tests/unit/scan.tcl') diff --git a/tests/unit/scan.tcl b/tests/unit/scan.tcl new file mode 100644 index 0000000..5dea76b --- /dev/null +++ b/tests/unit/scan.tcl @@ -0,0 +1,330 @@ +start_server {tags {"scan network"}} { + test "SCAN basic" { + r flushdb + 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 + 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 + 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 + 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_encoding $enc set + + # 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 {listpack hashtable} { + test "HSCAN with encoding $enc" { + # Create the Hash + r del hash + if {$enc eq {listpack}} { + 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_encoding $enc hash + + # 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 {listpack skiplist} { + test "ZSCAN with encoding $enc" { + # Create the Sorted Set + r del zset + if {$enc eq {listpack}} { + 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_encoding $enc zset + + # 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 + 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" + } + } + } + } +} -- cgit v1.2.3