"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/error-extstore.t" (30 Mar 2022, 3819 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. See also the latest Fossies "Diffs" side-by-side code changes report for "error-extstore.t": 1.6.14_vs_1.6.15.

A hint: This file contains one or more very long lines, so maybe it is better readable using the pure text view mode that shows the contents as wrapped lines within the browser window.

    1 #!/usr/bin/perl
    2 # Test the "Error on get" path for extstore.
    3 # the entire error handling code for process_get_command() never worked, and
    4 # would infinite loop. get_extstore() can hit it sometimes.
    5 
    6 use strict;
    7 use warnings;
    8 
    9 use Test::More;
   10 use FindBin qw($Bin);
   11 use lib "$Bin/lib";
   12 use MemcachedTest;
   13 
   14 my $ext_path;
   15 
   16 if (!supports_extstore()) {
   17     plan skip_all => 'extstore not enabled';
   18     exit 0;
   19 }
   20 
   21 $ext_path = "/tmp/extstore.$$";
   22 
   23 my $server = new_memcached("-m 64 -I 4m -U 0 -o ext_page_size=8,ext_wbuf_size=8,ext_threads=1,ext_io_depth=2,ext_item_size=512,ext_item_age=2,ext_recache_rate=10000,ext_max_frag=0.9,ext_path=$ext_path:64m,slab_automove=0,ext_compact_under=1,ext_max_sleep=100000");
   24 my $sock = $server->sock;
   25 
   26 # Wait until all items have flushed
   27 sub wait_for_ext {
   28     my $sum = 1;
   29     while ($sum != 0) {
   30         my $s = mem_stats($sock, "items");
   31         $sum = 0;
   32         for my $key (keys %$s) {
   33             if ($key =~ m/items:(\d+):number/) {
   34                 # Ignore classes which can contain extstore items
   35                 next if $1 < 3;
   36                 $sum += $s->{$key};
   37             }
   38         }
   39         sleep 1 if $sum != 0;
   40     }
   41 }
   42 
   43 # We're testing to ensure item chaining doesn't corrupt or poorly overlap
   44 # data, so create a non-repeating pattern.
   45 my @parts = ();
   46 for (1 .. 8000) {
   47     push(@parts, $_);
   48 }
   49 my $pattern = join(':', @parts);
   50 my $plen = length($pattern);
   51 
   52 # Set some large items and let them flush to extstore.
   53 for (1..5) {
   54     my $size = 3000 * 1024;
   55     my $data = "x" x $size;
   56     print $sock "set foo$_ 0 0 $size\r\n$data\r\n";
   57     my $res = <$sock>;
   58     is($res, "STORED\r\n", "stored some big items");
   59 }
   60 
   61 wait_for_ext();
   62 
   63 {
   64     my $long_key = "f" x 512;
   65     print $sock "get foo1 foo2 foo3 $long_key\r\n";
   66     ok(scalar <$sock> =~ /CLIENT_ERROR bad command line format/, 'long key fails');
   67     my $stats = mem_stats($sock);
   68     cmp_ok($stats->{get_aborted_extstore}, '>', 1, 'some extstore queries aborted');
   69 }
   70 
   71 # Infinite loop: if we aborted some extstore requests, the next request would hang
   72 # the daemon.
   73 {
   74     my $size = 3000 * 1024;
   75     my $data = "x" x $size;
   76     mem_get_is($sock, "foo1", $data);
   77 }
   78 
   79 # Disable automatic page balancing, then move enough pages that the large
   80 # items can no longer be loaded from extstore
   81 {
   82     print $sock "slabs automove 0\r\n";
   83     my $res = <$sock>;
   84     my $source = 0;
   85     while (1) {
   86         print $sock "slabs reassign $source 1\r\n";
   87         $res = <$sock>;
   88         if ($res =~ m/NOSPARE/) {
   89             $source = -1;
   90             my $stats = mem_stats($sock, 'slabs');
   91             for my $key (grep { /total_pages/ } keys %$stats) {
   92                 if ($key =~ m/(\d+):total_pages/) {
   93                     next if $1 < 3;
   94                     $source = $1 if $stats->{$key} > 1;
   95                 }
   96             }
   97             last if $source == -1;
   98         }
   99         select undef, undef, undef, 0.10;
  100     }
  101 }
  102 
  103 # fetching the large keys should now fail.
  104 {
  105     print $sock "get foo1\r\n";
  106     my $res = <$sock>;
  107     $res =~ s/[\r\n]//g;
  108     is($res, 'SERVER_ERROR out of memory writing get response', 'can no longer read back item');
  109     my $stats = mem_stats($sock);
  110     is($stats->{get_oom_extstore}, 1, 'check extstore oom counter');
  111 }
  112 
  113 # Leaving this for future generations.
  114 # The process_get_command() function had several memory leaks.
  115 my $LEAK_TEST = 0;
  116 if ($LEAK_TEST) {
  117     my $tries = 0;
  118     while ($tries) {
  119         print $sock "slabs reassign 1 39\r\n";
  120         my $res = <$sock>;
  121         if ($res =~ m/BUSY/) {
  122             select undef, undef, undef, 0.10;
  123         } else {
  124             $tries--;
  125         }
  126     }
  127     my $long_key = "f" x 512;
  128     while (1) {
  129         print $sock "get foo1 foo2 foo3 $long_key\r\n";
  130         my $res = <$sock>;
  131     }
  132 }
  133 
  134 done_testing();
  135 
  136 END {
  137     unlink $ext_path if $ext_path;
  138 }