redis/tests/unit/scan.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"
                }
            }
        }
    }
}