Permalink
Browse files

PLCBC-12: Add 'compat' tests, and fix compat-mode cas

Also, forward-port some fixes from 'stable' mode
  • Loading branch information...
1 parent 2acbca3 commit b4ee1413746fe58f99d53e48a4560aa794ec195c @mnunberg committed Dec 19, 2012
Showing with 139 additions and 14 deletions.
  1. +1 −0 MANIFEST.in
  2. +35 −14 lib/Couchbase/Client/Compat.pm
  3. +101 −0 lib/Couchbase/Test/Compat.pm
  4. +2 −0 t/01-main.t
View
@@ -34,6 +34,7 @@ lib/Couchbase/Client/Async/Event.pm
lib/Couchbase/MockServer.pm
lib/Couchbase/Test/ClientSync.pm
lib/Couchbase/Test/Common.pm
+lib/Couchbase/Test/Compat.pm
lib/Couchbase/Test/Async.pm
lib/Couchbase/Test/Async/Loop.pm
lib/Couchbase/Test/Settings.pm
@@ -18,7 +18,7 @@ our %ErrorMap = (
sub return_for_multi_wrap {
my ($requests,$response,$op) = @_;
-
+
if(wantarray) {
#ugh, really?
my @retvals;
@@ -38,60 +38,81 @@ sub return_for_multi_wrap {
}
sub return_for_op {
- my ($retval, $op) = @_;
-
+ my ($retval, $op) = @_;
+
my $errval = $retval->errnum;
-
+
if ($errval) {
$errval = $ErrorMap{$errval};
}
-
+
if ($retval->errnum && (!defined $errval)) {
# Fatal error:
return undef;
}
-
+
if ($op =~ /^(?:get|incr|decr)$/) {
return $retval->value;
}
-
+
if ($op eq 'gets') {
return [$retval->cas, $retval->value];
}
-
+
if ($op =~ /^(?:set|cas|add|append|prepend|replace|remove|delete)/) {
return int($retval->errnum == 0);
}
-
+
}
sub new {
my ($cls,$options) = @_;
my $o = $cls->SUPER::new($options);
+ bless $o, $cls;
+ return $o;
}
foreach my $sub (qw(
get gets
set append prepend replace add
remove delete
- incr decr cas)) {
+ incr decr)) {
no strict 'refs';
*{$sub} = sub {
my $self = shift;
- my $ret = $self->{\"SUPER::$sub"}(@_);
+ my $ret = $self->${\"SUPER::$sub"}(@_);
$ret = return_for_op($ret, $sub);
return $ret;
};
-
+
my $multi = "$sub\_multi";
*{$multi} = sub {
my $self = shift;
- my $ret = $self->{\"SUPER::$multi"}(@_);
+ my $ret = $self->${\"SUPER::$multi"}(@_);
return return_for_multi_wrap(\@_, $ret, $sub)
};
}
+
+
+# CAS Handling is different in
+sub cas {
+ my ($self,$key, $cas,$value) = @_;
+ return return_for_op($self->SUPER::cas($key, $value, $cas), 'cas');
+}
+
+sub cas_multi {
+ my ($self,@params) = @_;
+ my @newvals;
+ foreach my $compat_args (@params) {
+ my ($key,$cas,$value) = @$compat_args;
+ push @newvals, [$key, $value, $cas];
+ }
+ my $ret = $self->SUPER::cas_multi_A(\@newvals);
+ return return_for_multi_wrap(\@params, $ret, 'cas');
+}
+
1;
__END__
@@ -149,4 +170,4 @@ L<Cache::Memcached::libmemcached>
Copyright (C) 2012 M. Nunberg
You may use and distribute this software under the same terms, licensing, and
-conditions as perl itself.
+conditions as perl itself.
@@ -0,0 +1,101 @@
+package Couchbase::Test::Compat;
+use strict;
+use warnings;
+use base qw(Couchbase::Test::Common);
+use Couchbase::Client;
+use Couchbase::Client::Compat;
+use Data::Dumper;
+use Test::More;
+
+sub setup_client :Test(startup) {
+ my $self = shift;
+ $self->mock_init();
+
+ my %options = (
+ %{$self->common_options}
+ );
+
+ my $o = Couchbase::Client::Compat->new(\%options);
+ $self->cbo( $o );
+}
+
+sub cbo {
+ if(@_ == 1) {
+ return $_[0]->{object};
+ } elsif (@_ == 2) {
+ $_[0]->{object} = $_[1];
+ return $_[1];
+ }
+}
+
+sub T201_test_set :Test(no_plan)
+{
+ my $self = shift;
+ my $rv;
+ $rv = $self->cbo->set("key", "value");
+ ok($rv, "Simple set returns OK");
+
+ $rv = $self->cbo->set("key", "value", 1);
+ ok($rv, "Set with expiry");
+
+ $self->cbo->remove("non-exist-key");
+ $rv = $self->cbo->get("key");
+ is($rv, "value");
+ ok($rv, "Get returns value itself");
+
+ $rv = $self->cbo->get("non-exist-key");
+ ok(!$rv, "get miss returns false");
+
+ my $rvs;
+}
+
+sub T202_test_cas :Test(no_plan)
+{
+ my $self = shift;
+ my $rv;
+ my $cas;
+ my $o = $self->cbo;
+
+ $o->set("key", "value");
+ $rv = $o->gets("key");
+ isa_ok($rv, 'ARRAY');
+
+ is($rv->[1], "value", "have value as first element");
+ ok($rv->[0], "have CAS as second element");
+
+ $rv = $o->cas("key", @$rv);
+}
+
+sub T203_test_multi :Test(no_plan)
+{
+ my $self = shift;
+ my $o = $self->cbo;
+ my $rvs;
+
+ $o->set("key", "value");
+ $o->remove("non-exist-key");
+
+ $rvs = $self->cbo->get_multi("key", "non-exist-key");
+ isa_ok($rvs, 'HASH', "get_multi returns hashref");
+
+ is($rvs->{key}, "value", "get_multi in hashref returns proper found value");
+ ok(exists ${$rvs}{"non-exist-key"},
+ "non-exist-key present but false in hash");
+
+
+ $o->set_multi(["key1", "value1"], ["key2", "value2"]);
+ $rvs = $o->gets_multi("key1", "key2");
+
+ my @cas_params;
+ while (my ($k,$v) = each %$rvs) {
+ push @cas_params, [ $k, @$v ];
+ }
+
+ $rvs = $o->cas_multi(@cas_params);
+ my @errs = grep { !$_ } values %$rvs;
+ is(@errs, 0, "No errors");
+ is(scalar keys %$rvs, 2, "got all keys");
+}
+
+
+1;
View
@@ -28,11 +28,13 @@ use Couchbase::Test::Settings;
use Couchbase::Test::Interop;
use Couchbase::Test::Netfail;
use Couchbase::Test::Views;
+use Couchbase::Test::Compat;
Couchbase::Test::ClientSync->runtests();
Couchbase::Test::Async->runtests();
Couchbase::Test::Settings->runtests();
Couchbase::Test::Interop->runtests();
Couchbase::Test::Netfail->runtests();
Couchbase::Test::Views->runtests();
+Couchbase::Test::Compat->runtests();
#Test::Class->runtests();

0 comments on commit b4ee141

Please sign in to comment.