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