"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/chunked-items.t" (21 Feb 2022, 3901 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 # Networked logging tests.
    3 
    4 use strict;
    5 use warnings;
    6 
    7 use Test::More;
    8 use FindBin qw($Bin);
    9 use lib "$Bin/lib";
   10 use MemcachedTest;
   11 
   12 my $server = new_memcached('-m 48 -o slab_chunk_max=16384');
   13 my $sock = $server->sock;
   14 
   15 # We're testing to ensure item chaining doesn't corrupt or poorly overlap
   16 # data, so create a non-repeating pattern.
   17 my @parts = ();
   18 for (1 .. 8000) {
   19     push(@parts, $_);
   20 }
   21 my $pattern = join(':', @parts);
   22 
   23 my $plen = length($pattern);
   24 
   25 print $sock "set pattern 0 0 $plen\r\n$pattern\r\n";
   26 is(scalar <$sock>, "STORED\r\n", "stored pattern successfully");
   27 
   28 mem_get_is($sock, "pattern", $pattern);
   29 
   30 for (1..5) {
   31     my $size = 400 * 1024;
   32     my $data = "x" x $size;
   33     print $sock "set foo$_ 0 0 $size\r\n$data\r\n";
   34     my $res = <$sock>;
   35     is($res, "STORED\r\n", "stored some big items: $size");
   36 }
   37 
   38 {
   39     my $max = 1024 * 1024;
   40     my $big = "a big value that's > .5M and < 1M. ";
   41     while (length($big) * 2 < $max) {
   42         $big = $big . $big;
   43     }
   44     my $biglen = length($big);
   45 
   46     for (1..100) {
   47         print $sock "set toast$_ 0 0 $biglen\r\n$big\r\n";
   48         is(scalar <$sock>, "STORED\r\n", "stored big");
   49         mem_get_is($sock, "toast$_", $big);
   50     }
   51 }
   52 
   53 # Test a wide range of sets.
   54 {
   55     my $len = 1024 * 200;
   56     while ($len < 1024 * 1024) {
   57         my $val = "B" x $len;
   58         print $sock "set foo_$len 0 0 $len\r\n$val\r\n";
   59         is(scalar <$sock>, "STORED\r\n", "stored size $len");
   60         $len += 2048;
   61     }
   62 }
   63 
   64 # Test long appends and prepends.
   65 # Note: memory bloats like crazy if we use one test per request.
   66 {
   67     my $str = 'seedstring';
   68     my $len = length($str);
   69     print $sock "set appender 0 0 $len\r\n$str\r\n";
   70     is(scalar <$sock>, "STORED\r\n", "stored seed string for append");
   71     my $unexpected = 0;
   72     for my $part (@parts) {
   73         # reduce required loops but still have a pattern.
   74         my $todo = $part . "x" x 10;
   75         $str .= $todo;
   76         my $len = length($todo);
   77         print $sock "append appender 0 0 $len\r\n$todo\r\n";
   78         is(scalar <$sock>, "STORED\r\n", "append $todo size $len");
   79         print $sock "get appender\r\n";
   80         my $header = scalar <$sock>;
   81         my $body = scalar <$sock>;
   82         my $end = scalar <$sock>;
   83         $unexpected++ unless $body eq "$str\r\n";
   84     }
   85     is($unexpected, 0, "No unexpected results during appends\n");
   86     # Now test appending a chunked item to a chunked item.
   87     $len = length($str);
   88     print $sock "append appender 0 0 $len\r\n$str\r\n";
   89     is(scalar <$sock>, "STORED\r\n", "append large string size $len");
   90     mem_get_is($sock, "appender", $str . $str);
   91     print $sock "delete appender\r\n";
   92     is(scalar <$sock>, "DELETED\r\n", "removed appender key");
   93 }
   94 
   95 {
   96     my $str = 'seedstring';
   97     my $len = length($str);
   98     print $sock "set prepender 0 0 $len\r\n$str\r\n";
   99     is(scalar <$sock>, "STORED\r\n", "stored seed string for append");
  100     my $unexpected = 0;
  101     for my $part (@parts) {
  102         # reduce required loops but still have a pattern.
  103         $part .= "x" x 10;
  104         $str = $part . $str;
  105         my $len = length($part);
  106         print $sock "prepend prepender 0 0 $len\r\n$part\r\n";
  107         is(scalar <$sock>, "STORED\r\n", "prepend $part size $len");
  108         print $sock "get prepender\r\n";
  109         my $header = scalar <$sock>;
  110         my $body = scalar <$sock>;
  111         my $end = scalar <$sock>;
  112         $unexpected++ unless $body eq "$str\r\n";
  113     }
  114     is($unexpected, 0, "No unexpected results during prepends\n");
  115     # Now test prepending a chunked item to a chunked item.
  116     $len = length($str);
  117     print $sock "prepend prepender 0 0 $len\r\n$str\r\n";
  118     is(scalar <$sock>, "STORED\r\n", "prepend large string size $len");
  119     mem_get_is($sock, "prepender", $str . $str);
  120     print $sock "delete prepender\r\n";
  121     is(scalar <$sock>, "DELETED\r\n", "removed prepender key");
  122 }
  123 
  124 done_testing();