"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/getset.t" (21 Feb 2022, 3763 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 => 37991;
    5 use FindBin qw($Bin);
    6 use lib "$Bin/lib";
    7 use MemcachedTest;
    8 
    9 
   10 my $server = new_memcached('-m 128');
   11 my $sock = $server->sock;
   12 
   13 
   14 # set foo (and should get it)
   15 print $sock "set foo 0 0 6\r\nfooval\r\n";
   16 is(scalar <$sock>, "STORED\r\n", "stored foo");
   17 mem_get_is($sock, "foo", "fooval");
   18 
   19 # add bar (and should get it)
   20 print $sock "add bar 0 0 6\r\nbarval\r\n";
   21 is(scalar <$sock>, "STORED\r\n", "stored barval");
   22 mem_get_is($sock, "bar", "barval");
   23 
   24 # add foo (but shouldn't get new value)
   25 print $sock "add foo 0 0 5\r\nfoov2\r\n";
   26 is(scalar <$sock>, "NOT_STORED\r\n", "not stored");
   27 mem_get_is($sock, "foo", "fooval");
   28 
   29 # replace bar (should work)
   30 print $sock "replace bar 0 0 6\r\nbarva2\r\n";
   31 is(scalar <$sock>, "STORED\r\n", "replaced barval 2");
   32 
   33 # replace notexist (shouldn't work)
   34 print $sock "replace notexist 0 0 6\r\nbarva2\r\n";
   35 is(scalar <$sock>, "NOT_STORED\r\n", "didn't replace notexist");
   36 
   37 # delete foo.
   38 print $sock "delete foo\r\n";
   39 is(scalar <$sock>, "DELETED\r\n", "deleted foo");
   40 
   41 # delete foo again.  not found this time.
   42 print $sock "delete foo\r\n";
   43 is(scalar <$sock>, "NOT_FOUND\r\n", "deleted foo, but not found");
   44 
   45 # add moo
   46 #
   47 print $sock "add moo 0 0 6\r\nmooval\r\n";
   48 is(scalar <$sock>, "STORED\r\n", "stored barval");
   49 mem_get_is($sock, "moo", "mooval");
   50 
   51 # check-and-set (cas) failure case, try to set value with incorrect cas unique val
   52 print $sock "cas moo 0 0 6 0\r\nMOOVAL\r\n";
   53 is(scalar <$sock>, "EXISTS\r\n", "check and set with invalid id");
   54 
   55 # test "gets", grab unique ID
   56 print $sock "gets moo\r\n";
   57 # VALUE moo 0 6 3084947704
   58 #
   59 my @retvals = split(/ /, scalar <$sock>);
   60 my $data = scalar <$sock>; # grab data
   61 my $dot  = scalar <$sock>; # grab dot on line by itself
   62 is($retvals[0], "VALUE", "get value using 'gets'");
   63 my $unique_id = $retvals[4];
   64 # clean off \r\n
   65 $unique_id =~ s/\r\n$//;
   66 ok($unique_id =~ /^\d+$/, "unique ID '$unique_id' is an integer");
   67 # now test that we can store moo with the correct unique id
   68 print $sock "cas moo 0 0 6 $unique_id\r\nMOOVAL\r\n";
   69 is(scalar <$sock>, "STORED\r\n");
   70 mem_get_is($sock, "moo", "MOOVAL");
   71 
   72 # pipeline is okay
   73 print $sock "set foo 0 0 6\r\nfooval\r\ndelete foo\r\nset foo 0 0 6\r\nfooval\r\ndelete foo\r\n";
   74 is(scalar <$sock>, "STORED\r\n",  "pipeline set");
   75 is(scalar <$sock>, "DELETED\r\n", "pipeline delete");
   76 is(scalar <$sock>, "STORED\r\n",  "pipeline set");
   77 is(scalar <$sock>, "DELETED\r\n", "pipeline delete");
   78 
   79 
   80 # Test sets up to a large size around 1MB.
   81 # Everything up to 1MB - 1k should succeed, everything 1MB +1k should fail.
   82 
   83 my $len = 1024;
   84 while ($len < 1024*1028) {
   85     my $val = "B"x$len;
   86     if ($len > (1024*1024)) {
   87         # Ensure causing a memory overflow doesn't leave stale data.
   88         print $sock "set foo_$len 0 0 3\r\nMOO\r\n";
   89         is(scalar <$sock>, "STORED\r\n");
   90         print $sock "set foo_$len 0 0 $len\r\n$val\r\n";
   91         is(scalar <$sock>, "SERVER_ERROR object too large for cache\r\n", "failed to store size $len");
   92         mem_get_is($sock, "foo_$len");
   93     } else {
   94         print $sock "set foo_$len 0 0 $len\r\n$val\r\n";
   95         is(scalar <$sock>, "STORED\r\n", "stored size $len");
   96     }
   97     $len += 2048;
   98 }
   99 
  100 {
  101     # Test large ASCII multigets.
  102     print $sock "set foobarbaz 0 0 2\r\nhi\r\n";
  103     is(scalar <$sock>, "STORED\r\n",  "base foo stored");
  104 
  105     my $len = 1024 * 128;
  106     my $klist = '';
  107     my $kcount = 0;
  108     for (my $x = 0; $x < $len; $x += 7) {
  109         $klist .= "foobarbaz ";
  110         $kcount++;
  111     }
  112     print $sock "get $klist\r\n";
  113 
  114     while ($kcount--) {
  115         is(scalar <$sock>, "VALUE foobarbaz 0 2\r\n", "foo returned");
  116         is(scalar <$sock>, "hi\r\n", "foo 'hi' returned");
  117     }
  118     is(scalar <$sock>, "END\r\n", "foo END seen");
  119 }