1#!/usr/bin/perl 2 3use strict; 4use Test::More tests => 46; 5use FindBin qw($Bin); 6use lib "$Bin/lib"; 7use MemcachedTest; 8 9 10my $server = new_memcached(); 11my $sock = $server->sock; 12my $sock2 = $server->new_sock; 13 14my @result; 15my @result2; 16 17ok($sock != $sock2, "have two different connections open"); 18 19sub 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 30check_args "cas bad blah 0 0 0\r\n\r\n", "bad flags"; 31check_args "cas bad 0 blah 0 0\r\n\r\n", "bad exp"; 32check_args "cas bad 0 0 blah 0\r\n\r\n", "bad cas"; 33check_args "cas bad 0 0 0 blah\r\n\r\n", "bad size"; 34 35# gets foo (should not exist) 36print $sock "gets foo\r\n"; 37is(scalar <$sock>, "END\r\n", "gets failed"); 38 39# set foo 40print $sock "set foo 0 0 6\r\nbarval\r\n"; 41is(scalar <$sock>, "STORED\r\n", "stored barval"); 42 43# gets foo and verify identifier exists 44@result = mem_gets($sock, "foo"); 45mem_gets_is($sock,$result[0],"foo","barval"); 46 47# cas fail 48print $sock "cas foo 0 0 6 123\r\nbarva2\r\n"; 49is(scalar <$sock>, "EXISTS\r\n", "cas failed for foo"); 50 51# gets foo - success 52@result = mem_gets($sock, "foo"); 53mem_gets_is($sock,$result[0],"foo","barval"); 54 55# cas success 56print $sock "cas foo 0 0 6 $result[0]\r\nbarva2\r\n"; 57is(scalar <$sock>, "STORED\r\n", "cas success, set foo"); 58 59# cas failure (reusing the same key) 60print $sock "cas foo 0 0 6 $result[0]\r\nbarva2\r\n"; 61is(scalar <$sock>, "EXISTS\r\n", "reusing a CAS ID"); 62 63# delete foo 64print $sock "delete foo\r\n"; 65is(scalar <$sock>, "DELETED\r\n", "deleted foo"); 66 67# cas missing 68print $sock "cas foo 0 0 6 $result[0]\r\nbarva2\r\n"; 69is(scalar <$sock>, "NOT_FOUND\r\n", "cas failed, foo does not exist"); 70 71# cas empty 72print $sock "cas foo 0 0 6 \r\nbarva2\r\n"; 73is(scalar <$sock>, "ERROR\r\n", "cas empty, throw error"); 74# cant parse barval2\r\n 75is(scalar <$sock>, "ERROR\r\n", "error out on barval2 parsing"); 76 77# set foo1 78print $sock "set foo1 0 0 1\r\n1\r\n"; 79is(scalar <$sock>, "STORED\r\n", "set foo1"); 80# set foo2 81print $sock "set foo2 0 0 1\r\n2\r\n"; 82is(scalar <$sock>, "STORED\r\n", "set foo2"); 83 84# gets foo1 check 85print $sock "gets foo1\r\n"; 86ok(scalar <$sock> =~ /VALUE foo1 0 1 (\d+)\r\n/, "gets foo1 regexp success"); 87my $foo1_cas = $1; 88is(scalar <$sock>, "1\r\n","gets foo1 data is 1"); 89is(scalar <$sock>, "END\r\n","gets foo1 END"); 90 91# gets foo2 check 92print $sock "gets foo2\r\n"; 93ok(scalar <$sock> =~ /VALUE foo2 0 1 (\d+)\r\n/,"gets foo2 regexp success"); 94my $foo2_cas = $1; 95is(scalar <$sock>, "2\r\n","gets foo2 data is 2"); 96is(scalar <$sock>, "END\r\n","gets foo2 END"); 97 98# validate foo1 != foo2 99ok($foo1_cas != $foo2_cas,"foo1 != foo2 single-gets success"); 100 101# multi-gets 102print $sock "gets foo1 foo2\r\n"; 103ok(scalar <$sock> =~ /VALUE foo1 0 1 (\d+)\r\n/, "validating first set of data is foo1"); 104$foo1_cas = $1; 105is(scalar <$sock>, "1\r\n", "validating foo1 set of data is 1"); 106ok(scalar <$sock> =~ /VALUE foo2 0 1 (\d+)\r\n/, "validating second set of data is foo2"); 107$foo2_cas = $1; 108is(scalar <$sock>, "2\r\n", "validating foo2 set of data is 2"); 109is(scalar <$sock>, "END\r\n","validating foo1,foo2 gets is over - END"); 110 111# validate foo1 != foo2 112ok($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"); 118ok($result[0] != "", "sock - gets foo1 is not empty"); 119 120# gets foo2 - success 121@result2 = mem_gets($sock2, "foo1"); 122ok($result2[0] != "","sock2 - gets foo1 is not empty"); 123 124print $sock "cas foo1 0 0 6 $result[0]\r\nbarva2\r\n"; 125print $sock2 "cas foo1 0 0 5 $result2[0]\r\napple\r\n"; 126 127my $res1 = <$sock>; 128my $res2 = <$sock2>; 129 130ok( ( $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 137print $sock "set bug15 0 0 1\r\n0\r\n"; 138is(scalar <$sock>, "STORED\r\n", "stored 0"); 139 140# Check out the first gets. 141print $sock "gets bug15\r\n"; 142ok(scalar <$sock> =~ /VALUE bug15 0 1 (\d+)\r\n/, "gets bug15 regexp success"); 143my $bug15_cas = $1; 144is(scalar <$sock>, "0\r\n", "gets bug15 data is 0"); 145is(scalar <$sock>, "END\r\n","gets bug15 END"); 146 147# Increment 148print $sock "incr bug15 1\r\n"; 149is(scalar <$sock>, "1\r\n", "incr worked"); 150 151# Validate a changed CAS 152print $sock "gets bug15\r\n"; 153ok(scalar <$sock> =~ /VALUE bug15 0 1 (\d+)\r\n/, "gets bug15 regexp success"); 154my $next_bug15_cas = $1; 155is(scalar <$sock>, "1\r\n", "gets bug15 data is 0"); 156is(scalar <$sock>, "END\r\n","gets bug15 END"); 157 158ok($bug15_cas != $next_bug15_cas, "CAS changed"); 159 160# validate that the stats gets updated 161my $stats = mem_stats($sock); 162is($stats->{cas_hits}, 2); 163is($stats->{cas_misses}, 1); 164is($stats->{cas_badval}, 3); 165