git.m6w6.name Git - awesomized/libmemcached/blob - memcached/t/getset.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Test::More tests => 539;
   5 use FindBin qw($Bin);
   6 use lib "$Bin/lib";
   7 use MemcachedTest;
   8
   9
  10 my $server = new_memcached();
  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 # pipeling 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