"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/lru.t" (16 Jul 2020, 1642 Bytes) of package /linux/www/memcached-1.6.15.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.

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use Test::More tests => 149;
    5 use FindBin qw($Bin);
    6 use lib "$Bin/lib";
    7 use MemcachedTest;
    8 
    9 # assuming max slab is 1M and default mem is 64M
   10 my $server = new_memcached('-o no_modern');
   11 my $sock = $server->sock;
   12 
   13 # create a big value for the largest slab
   14 my $max = 1024 * 1024;
   15 my $big = 'x' x (1024 * 1024 - 250);
   16 
   17 ok(length($big) > 512 * 1024);
   18 ok(length($big) < 1024 * 1024);
   19 
   20 # test that an even bigger value is rejected while we're here
   21 my $too_big = $big . $big . $big;
   22 my $len = length($too_big);
   23 print $sock "set too_big 0 0 $len\r\n$too_big\r\n";
   24 is(scalar <$sock>, "SERVER_ERROR object too large for cache\r\n", "too_big not stored");
   25 
   26 # set the big value
   27 my $len = length($big);
   28 print $sock "set big 0 0 $len\r\n$big\r\n";
   29 is(scalar <$sock>, "STORED\r\n", "stored big");
   30 mem_get_is($sock, "big", $big);
   31 
   32 # no evictions yet
   33 my $stats = mem_stats($sock);
   34 is($stats->{"evictions"}, "0", "no evictions to start");
   35 
   36 # set many big items, enough to get evictions
   37 for (my $i = 0; $i < 100; $i++) {
   38   print $sock "set item_$i 0 0 $len\r\n$big\r\n";
   39   is(scalar <$sock>, "STORED\r\n", "stored item_$i");
   40 }
   41 
   42 # some evictions should have happened
   43 my $stats = mem_stats($sock);
   44 my $evictions = int($stats->{"evictions"});
   45 ok($evictions == 37, "some evictions happened");
   46 
   47 # the first big value should be gone
   48 mem_get_is($sock, "big", undef);
   49 
   50 # the earliest items should be gone too
   51 for (my $i = 0; $i < $evictions - 1; $i++) {
   52   mem_get_is($sock, "item_$i", undef);
   53 }
   54 
   55 # check that the non-evicted are the right ones
   56 for (my $i = $evictions - 1; $i < $evictions + 4; $i++) {
   57   mem_get_is($sock, "item_$i", $big);
   58 }