"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/cas.t" (16 Jul 2020, 4701 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 => 43;
    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 my $sock2 = $server->new_sock;
   13 
   14 my @result;
   15 my @result2;
   16 
   17 ok($sock != $sock2, "have two different connections open");
   18 
   19 sub check_args {
   20     my ($line, $name) = @_;
   21 
   22     my $svr = new_memcached();
   23     my $s = $svr->sock;
   24 
   25     print $s $line;
   26     is(scalar <$s>, "CLIENT_ERROR bad command line format\r\n", $name);
   27     undef $svr;
   28 }
   29 
   30 check_args "cas bad blah 0 0 0\r\n\r\n", "bad flags";
   31 check_args "cas bad 0 blah 0 0\r\n\r\n", "bad exp";
   32 check_args "cas bad 0 0 blah 0\r\n\r\n", "bad cas";
   33 check_args "cas bad 0 0 0 blah\r\n\r\n", "bad size";
   34 
   35 # gets foo (should not exist)
   36 print $sock "gets foo\r\n";
   37 is(scalar <$sock>, "END\r\n", "gets failed");
   38 
   39 # set foo
   40 print $sock "set foo 0 0 6\r\nbarval\r\n";
   41 is(scalar <$sock>, "STORED\r\n", "stored barval");
   42 
   43 # gets foo and verify identifier exists
   44 @result = mem_gets($sock, "foo");
   45 mem_gets_is($sock,$result[0],"foo","barval");
   46 
   47 # cas fail
   48 print $sock "cas foo 0 0 6 123\r\nbarva2\r\n";
   49 is(scalar <$sock>, "EXISTS\r\n", "cas failed for foo");
   50 
   51 # gets foo - success
   52 @result = mem_gets($sock, "foo");
   53 mem_gets_is($sock,$result[0],"foo","barval");
   54 
   55 # cas success
   56 print $sock "cas foo 0 0 6 $result[0]\r\nbarva2\r\n";
   57 is(scalar <$sock>, "STORED\r\n", "cas success, set foo");
   58 
   59 # cas failure (reusing the same key)
   60 print $sock "cas foo 0 0 6 $result[0]\r\nbarva2\r\n";
   61 is(scalar <$sock>, "EXISTS\r\n", "reusing a CAS ID");
   62 
   63 # delete foo
   64 print $sock "delete foo\r\n";
   65 is(scalar <$sock>, "DELETED\r\n", "deleted foo");
   66 
   67 # cas missing
   68 print $sock "cas foo 0 0 6 $result[0]\r\nbarva2\r\n";
   69 is(scalar <$sock>, "NOT_FOUND\r\n", "cas failed, foo does not exist");
   70 
   71 # cas empty
   72 print $sock "cas foo 0 0 6 \r\nbarva2\r\n";
   73 is(scalar <$sock>, "ERROR\r\n", "cas empty, throw error");
   74 # cant parse barval2\r\n
   75 is(scalar <$sock>, "ERROR\r\n", "error out on barval2 parsing");
   76 
   77 # set foo1
   78 print $sock "set foo1 0 0 1\r\n1\r\n";
   79 is(scalar <$sock>, "STORED\r\n", "set foo1");
   80 # set foo2
   81 print $sock "set foo2 0 0 1\r\n2\r\n";
   82 is(scalar <$sock>, "STORED\r\n", "set foo2");
   83 
   84 # gets foo1 check
   85 print $sock "gets foo1\r\n";
   86 ok(scalar <$sock> =~ /VALUE foo1 0 1 (\d+)\r\n/, "gets foo1 regexp success");
   87 my $foo1_cas = $1;
   88 is(scalar <$sock>, "1\r\n","gets foo1 data is 1");
   89 is(scalar <$sock>, "END\r\n","gets foo1 END");
   90 
   91 # gets foo2 check
   92 print $sock "gets foo2\r\n";
   93 ok(scalar <$sock> =~ /VALUE foo2 0 1 (\d+)\r\n/,"gets foo2 regexp success");
   94 my $foo2_cas = $1;
   95 is(scalar <$sock>, "2\r\n","gets foo2 data is 2");
   96 is(scalar <$sock>, "END\r\n","gets foo2 END");
   97 
   98 # validate foo1 != foo2
   99 ok($foo1_cas != $foo2_cas,"foo1 != foo2 single-gets success");
  100 
  101 # multi-gets
  102 print $sock "gets foo1 foo2\r\n";
  103 ok(scalar <$sock> =~ /VALUE foo1 0 1 (\d+)\r\n/, "validating first set of data is foo1");
  104 $foo1_cas = $1;
  105 is(scalar <$sock>, "1\r\n", "validating foo1 set of data is 1");
  106 ok(scalar <$sock> =~ /VALUE foo2 0 1 (\d+)\r\n/, "validating second set of data is foo2");
  107 $foo2_cas = $1;
  108 is(scalar <$sock>, "2\r\n", "validating foo2 set of data is 2");
  109 is(scalar <$sock>, "END\r\n","validating foo1,foo2 gets is over - END");
  110 
  111 # validate foo1 != foo2
  112 ok($foo1_cas != $foo2_cas, "foo1 != foo2 multi-gets success");
  113 
  114 ### simulate race condition with cas
  115 
  116 # gets foo1 - success
  117 @result = mem_gets($sock, "foo1");
  118 ok($result[0] != "", "sock - gets foo1 is not empty");
  119 
  120 # gets foo2 - success
  121 @result2 = mem_gets($sock2, "foo1");
  122 ok($result2[0] != "","sock2 - gets foo1 is not empty");
  123 
  124 print $sock "cas foo1 0 0 6 $result[0]\r\nbarva2\r\n";
  125 print $sock2 "cas foo1 0 0 5 $result2[0]\r\napple\r\n";
  126 
  127 my $res1 = <$sock>;
  128 my $res2 = <$sock2>;
  129 
  130 ok( ( $res1 eq "STORED\r\n" && $res2 eq "EXISTS\r\n") ||
  131     ( $res1 eq "EXISTS\r\n" && $res2 eq "STORED\r\n"),
  132     "cas on same item from two sockets");
  133 
  134 ### bug 15: http://code.google.com/p/memcached/issues/detail?id=15
  135 
  136 # set foo
  137 print $sock "set bug15 0 0 1\r\n0\r\n";
  138 is(scalar <$sock>, "STORED\r\n", "stored 0");
  139 
  140 # Check out the first gets.
  141 print $sock "gets bug15\r\n";
  142 ok(scalar <$sock> =~ /VALUE bug15 0 1 (\d+)\r\n/, "gets bug15 regexp success");
  143 my $bug15_cas = $1;
  144 is(scalar <$sock>, "0\r\n", "gets bug15 data is 0");
  145 is(scalar <$sock>, "END\r\n","gets bug15 END");
  146 
  147 # Increment
  148 print $sock "incr bug15 1\r\n";
  149 is(scalar <$sock>, "1\r\n", "incr worked");
  150 
  151 # Validate a changed CAS
  152 print $sock "gets bug15\r\n";
  153 ok(scalar <$sock> =~ /VALUE bug15 0 1 (\d+)\r\n/, "gets bug15 regexp success");
  154 my $next_bug15_cas = $1;
  155 is(scalar <$sock>, "1\r\n", "gets bug15 data is 1");
  156 is(scalar <$sock>, "END\r\n","gets bug15 END");
  157 
  158 ok($bug15_cas != $next_bug15_cas, "CAS changed");