"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.9/t/lru-crawler.t" (21 Nov 2020, 4481 Bytes) of package /linux/www/memcached-1.6.9.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "lru-crawler.t": 1.6.8_vs_1.6.9.

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use warnings;
    5 use Test::More tests => 70257;
    6 use FindBin qw($Bin);
    7 use lib "$Bin/lib";
    8 use MemcachedTest;
    9 
   10 my $server = new_memcached('-m 32 -o no_modern');
   11 {
   12     my $stats = mem_stats($server->sock, ' settings');
   13     is($stats->{lru_crawler}, "no");
   14 }
   15 
   16 my $sock = $server->sock;
   17 
   18 # Fill a slab a bit.
   19 # Some immortal items, some long expiring items, some short expiring items.
   20 # Done so the immortals end up at the tail.
   21 for (1 .. 30) {
   22     print $sock "set ifoo$_ 0 0 2\r\nok\r\n";
   23     is(scalar <$sock>, "STORED\r\n", "stored key");
   24 }
   25 for (1 .. 30) {
   26     print $sock "set lfoo$_ 0 3600 2\r\nok\r\n";
   27     is(scalar <$sock>, "STORED\r\n", "stored key");
   28 }
   29 for (1 .. 30) {
   30     print $sock "set sfoo$_ 0 1 2\r\nok\r\n";
   31     is(scalar <$sock>, "STORED\r\n", "stored key");
   32 }
   33 
   34 {
   35     my $slabs = mem_stats($sock, "slabs");
   36     is($slabs->{"1:used_chunks"}, 90, "slab1 has 90 used chunks");
   37 }
   38 
   39 sleep 3;
   40 
   41 print $sock "lru_crawler enable\r\n";
   42 is(scalar <$sock>, "OK\r\n", "enabled lru crawler");
   43 {
   44     my $stats = mem_stats($server->sock, ' settings');
   45     is($stats->{lru_crawler}, "yes");
   46 }
   47 
   48 print $sock "lru_crawler crawl 1\r\n";
   49 is(scalar <$sock>, "OK\r\n", "kicked lru crawler");
   50 while (1) {
   51     my $stats = mem_stats($sock);
   52     last unless $stats->{lru_crawler_running};
   53     sleep 1;
   54 }
   55 
   56 {
   57     my $slabs = mem_stats($sock, "slabs");
   58     is($slabs->{"1:used_chunks"}, 60, "slab1 now has 60 used chunks");
   59     my $items = mem_stats($sock, "items");
   60     is($items->{"items:1:crawler_reclaimed"}, 30, "slab1 has 30 reclaims");
   61 }
   62 
   63 # Ensure pipelined commands fail with metadump.
   64 # using metaget because get forces pipeline flush.
   65 {
   66     print $sock "mg foo v\r\nlru_crawler metadump all\r\n";
   67     is(scalar <$sock>, "EN\r\n");
   68     is(scalar <$sock>, "ERROR cannot pipeline other commands before metadump\r\n");
   69 }
   70 
   71 # Check that crawler metadump works correctly.
   72 {
   73     print $sock "lru_crawler metadump all\r\n";
   74     my $count = 0;
   75     while (<$sock>) {
   76         last if /^(\.|END)/;
   77         /^(key=) (\S+).*([^\r\n]+)/;
   78         $count++;
   79     }
   80     is ($count, 60, "metadump all returns all items");
   81 }
   82 
   83 for (1 .. 30) {
   84     mem_get_is($sock, "ifoo$_", "ok");
   85     mem_get_is($sock, "lfoo$_", "ok");
   86     mem_get_is($sock, "sfoo$_", undef);
   87 }
   88 
   89 # add a few more items into a different slab class
   90 my $mfdata = 'x' x 512;
   91 for (1 .. 30) {
   92     print $sock "set mfoo$_ 0 0 512\r\n$mfdata\r\n";
   93     is(scalar <$sock>, "STORED\r\n", "stored key");
   94 }
   95 
   96 # set enough small values to ensure bucket chaining happens
   97 # ... but not enough that hash table expansion happens.
   98 # TODO: check hash power level?
   99 my %bfoo = ();
  100 for (1 .. 70000) {
  101     print $sock "set bfoo$_ 0 0 1 noreply\r\nz\r\n";
  102     $bfoo{$_} = 1;
  103 }
  104 {
  105     print $sock "version\r\n";
  106     my $res = <$sock>;
  107     like($res, qr/^VERSION/, "bulk sets completed");
  108 }
  109 
  110 # Check metadump hash table walk returns correct number of items.
  111 {
  112     print $sock "lru_crawler metadump hash\r\n";
  113     my $count = 0;
  114     while (<$sock>) {
  115         last if /^(\.|END)/;
  116         if (/^key=bfoo(\S+)/) {
  117             ok(exists $bfoo{$1}, "found bfoo key $1 is still in test hash");
  118             delete $bfoo{$1};
  119         }
  120         $count++;
  121     }
  122     is ($count, 70090, "metadump hash returns all items");
  123     is ((keys %bfoo), 0, "metadump found all bfoo keys");
  124 }
  125 
  126 print $sock "lru_crawler disable\r\n";
  127 is(scalar <$sock>, "OK\r\n", "disabled lru crawler");
  128 my $settings_match = 0;
  129 # TODO: we retry a few times since the settings value is changed
  130 # outside of a memory barrier, but the thread is stopped before the OK is
  131 # returned.
  132 # At some point better handling of the setings synchronization should happen.
  133 for (1 .. 10) {
  134     my $stats = mem_stats($server->sock, ' settings');
  135     if ($stats->{lru_crawler} eq "no") {
  136         $settings_match = 1;
  137         last;
  138     }
  139     sleep 1;
  140 }
  141 is($settings_match, 1, "settings output matches crawler state");
  142 
  143 $server->stop;
  144 
  145 # Test initializing crawler from starttime.
  146 $server = new_memcached('-m 32 -o no_modern,lru_crawler');
  147 $sock = $server->sock;
  148 
  149 for (1 .. 30) {
  150     print $sock "set sfoo$_ 0 1 2\r\nok\r\n";
  151     is(scalar <$sock>, "STORED\r\n", "stored key");
  152 }
  153 
  154 sleep 3;
  155 
  156 print $sock "lru_crawler crawl 1\r\n";
  157 is(scalar <$sock>, "OK\r\n", "kicked lru crawler");
  158 while (1) {
  159     my $stats = mem_stats($sock);
  160     last unless $stats->{lru_crawler_running};
  161     sleep 1;
  162 }
  163 
  164 {
  165     my $slabs = mem_stats($sock, "slabs");
  166     is($slabs->{"1:used_chunks"}, 0, "slab1 now has 0 used chunks");
  167 }