Make tests more resilient, and make client less noisy

Tests can work well on both real and mock servers.
Better display output for skipped tests
Fixed some quirks (and skipped some tests) for 5.8.8

lib/Couchbase/Client.pm

@@ -154,13 +154,11 @@ sub new {
             push @all_errors, @$errors;
             foreach (@$errors) {
                 my ($errno,$errstr) = @$_;
-                warn("(cbc_errno=$errno)");
                 if(exists $RETRY_ERRORS{$errno}) {
                     $error_retriable++;
                 }
             }
             if(!$error_retriable) {
-                warn("Didn't find any non-retriable errors");
                 last;
             }
         } else {

lib/Couchbase/MockServer.pm

@@ -7,12 +7,11 @@ use URI;
 use File::Path qw(mkpath);
 use IO::Socket::INET;
 use Socket;
-use POSIX qw(:errno_h :signal_h);
+use POSIX qw(:errno_h :signal_h :sys_wait_h);
 use Time::HiRes;
-use Log::Fu;
+use Log::Fu { level => "warn" };
 use Data::Dumper;
-
-
+use Time::HiRes qw(sleep);
 
 my $SYMLINK = "CouchbaseMock_PLTEST.jar";
 our $INSTANCE;
@@ -78,6 +77,10 @@ sub _do_run {
     if($pid) {
         #Parent: setup harakiri monitoring socket
         $self->pid($pid);
+        sleep(0.05);
+        if(waitpid($pid, WNOHANG) > 0) {
+            die("Child process died prematurely");
+        }
         log_info("Launched CouchbaseMock PID=$pid");
         if($self->harakiri_socket) {
             $self->harakiri_socket->blocking(0);
@@ -103,8 +106,10 @@ sub _do_run {
             $self->harakiri_socket->blocking(1);
         }
     } else {
-        log_infof("Executing %s", join(" ", @command));
+        log_warnf("Executing %s", join(" ", @command));
         exec(@command);
+        warn"exec @command failed: $!";
+        exit(1);
     }
 }
 
@@ -191,7 +196,9 @@ sub respawn_node {
 
 sub DESTROY {
     my $self = shift;
+    return unless $self->pid;
     kill SIGTERM, $self->pid;
+    log_debugf("Waiting for process to terminate");
     waitpid($self->pid, 0);
     log_infof("Reaped PID %d, status %d", $self->pid, $? >> 8);
 

lib/Couchbase/Test/Async.pm

@@ -4,29 +4,37 @@ use warnings;
 
 use base qw(Couchbase::Test::Common);
 use base qw(POE::Sugar::Attributes);
-use POE::Kernel;
 use Test::More;
 use Couchbase::Client::Async;
 use Couchbase::Client::Errors;
 use Couchbase::Client::IDXConst;
-use Couchbase::Test::Async::Loop;
 use Array::Assign;
 use Data::Dumper;
 use Log::Fu;
 
 my $loop_session = "cbc_test_async";
 my $client_session = 'our_client';
-
 my $poe_kernel = 'POE::Kernel';
+
+my $can_async = eval {
+    use Couchbase::Test::Async::Loop;
+    use POE::Kernel; 1;
+};
+
+if(!$can_async) {
+    __PACKAGE__->SKIP_CLASS("Can't run async tests: $@");
+}
 $poe_kernel->run();
 
+
 my $ReadyReceived = 0;
 my $Return = undef;
 my $Errnum;
 
 sub setup_async :Test(startup) {
     my $self = shift;
     $self->mock_init();
+
     Couchbase::Test::Async::Loop->spawn($loop_session,
         on_ready => \&loop_ready,
         on_error => sub { $Errnum = $_[0]; diag "Grrr!"; },

lib/Couchbase/Test/Async/Loop.pm

@@ -130,7 +130,7 @@ sub update_timer :Event {
             $poe_kernel->alarm_remove($timer_id);
             $evdata->[EVIDX_PLDATA] = undef;
         } else {
-            log_err("Requested to delete non-existent timer ID");
+            log_debug("Requested to delete non-existent timer ID");
         }
     }
 }

lib/Couchbase/Test/ClientSync.pm

@@ -22,7 +22,6 @@ sub setup_client :Test(startup)
     $self->cbo( $o );
     $self->{basic_keys} = [qw(
         Foo Bar Baz Blargh Bleh Meh Grr Gah)];
-    $self->err_ok();
 }
 
 sub cbo {
@@ -73,6 +72,7 @@ sub get_ok {
 
 sub T00_set_values_simple :Test(no_plan) {
     my $self = shift;
+    $self->err_ok();
     foreach my $k (@{$self->{basic_keys}}) {
         $self->set_ok("Key '$k'", $k, $self->k2v($k));
         $self->get_ok($k, $self->k2v($k))

lib/Couchbase/Test/Common.pm

@@ -21,6 +21,20 @@ our $Mock;
 our $RealServer = $ENV{PLCB_TEST_REAL_SERVER};
 our $MemdPort = $ENV{PLCB_TEST_MEMD_PORT};
 
+sub SKIP_CLASS {
+    my ($cls,$msg) = @_;
+    if(defined $msg) {
+        my $cstr = ref $cls ? ref $cls : $cls;
+        my $header = ("#" x 10) . " $cstr SKIP " . ("#" x 10);
+
+        diag $header;
+        diag "";
+        diag $msg;
+        diag "";
+    }
+    goto &Test::Class::SKIP_CLASS;
+}
+
 sub mock_init
 {
     my $self = shift;
@@ -43,7 +57,6 @@ sub fetch_config {
     my $defpool = $confua->list_pools();
     $confua->pool_info($defpool);
     my $buckets = $confua->list_buckets($defpool);
-    $self->confua($confua);
     $self->res_buckets($buckets);
 }
 
@@ -115,10 +128,10 @@ sub v2k {
     reverse($v);
 }
 
+my $init_pid = $$;
 sub Initialize {
     my ($cls,%opts) = @_;
     if($RealServer && (!ref $RealServer) ) {
-        warn("Using real server..");
         my @kvpairs = split(/,/, $RealServer);
         $RealServer = {};
         foreach my $pair (@kvpairs) {
@@ -131,8 +144,11 @@ sub Initialize {
         $MemdPort ||= delete $RealServer->{memd_port};
         $Mock = 1;
     } else {
-
-        $Mock = Couchbase::MockServer->new(%opts);
+        eval {
+            $Mock = Couchbase::MockServer->new(%opts);
+        }; if( ($@ || (!$Mock)) && $$ == $init_pid) {
+            $cls->SKIP_ALL("Cannot run tests without mock server");
+        }
         return $Mock;
     }
 }

lib/Couchbase/Test/Interop.pm

@@ -7,32 +7,27 @@ use Couchbase::Client::Errors;
 use Data::Dumper;
 Log::Fu::set_log_level('Couchbase::Config', 'info');
 use Class::XSAccessor {
-    accessors => [qw(cbo memd memds vbconf confua)]
+    accessors => [qw(cbo memd)]
 };
 
 my $MEMD_CLASS;
 my $have_memcached = 
 eval {
     require Cache::Memcached::libmemcached;
     $MEMD_CLASS = "Cache::Memcached::libmemcached";
-} ||
-eval {
-    require Cache::Memcached;
-    $MEMD_CLASS = "Cache::Memcached";
-} ||
-eval {
-    require Cache::Memcached::Fast;
-    $MEMD_CLASS = "Cache::Memcached::Fast";
-};
+}; if ($@) {
+    diag "Memcached interop tests will not be available: $@";
+    __PACKAGE__->SKIP_CLASS("Need Cache::Memcached::libmemcached");
+}
+
+if($] < 5.010) {
+    __PACKAGE__->SKIP_CLASS("Cache::Memcached::libmemcached ".
+                    "segfaults on perls < 5.10");
+}
 
-use Couchbase::Config::UA;
 
 sub _setup_client :Test(startup) {
     my $self = shift;
-    if(!$have_memcached) {
-        $self->SKIP_ALL("Need Cache::Memcached::libmemcached");
-    }
-
     $self->mock_init();
 
     my $server = $self->common_options->{server};
@@ -45,14 +40,12 @@ sub _setup_client :Test(startup) {
     });
 
     $self->cbo($cbo);
+    unless($self->fetch_config()) {
+        diag "Skipping Cache::Memcached interop tests";
+        $self->SKIP_CLASS("Couldn't fetch buckets");
+    }
 
-    my $confua = Couchbase::Config::UA->new(
-        $server, username => $username, password => $password);
-
-    my $pool = $confua->list_pools();
-    $confua->pool_info($pool);
-    my $buckets = $confua->list_buckets($pool);
-
+    my $buckets = $self->res_buckets();
     my $bucket = (grep {
         $_->name eq $bucket_name &&
         $_->port_proxy || $_->type eq 'memcached'
@@ -94,7 +87,7 @@ sub T30_interop_init :Test(no_plan)
         my $ret = $self->cbo->get($key);
         ok($ret->is_ok, "Found value for memcached key");
         is($ret->value, $value, "Got back same value");
-            
+
         ok($self->cbo->set($key,$value)->is_ok, "set via cbc");
         is($memd->get($key), $value, "get via memd");
     }

lib/Couchbase/Test/Netfail.pm

@@ -18,13 +18,14 @@ my $have_vbucket = eval {
     1;
 };
 
+if($Couchbase::Test::Common::RealServer) {
+    __PACKAGE__->SKIP_CLASS("Can't perform network tests on real server");
+}
+
 sub startup_tests :Test(startup)
 {
     my $self = shift;
     $self->mock_init();
-    if($Couchbase::Test::Common::RealServer) {
-        $self->SKIP_ALL("Can't perform network tests on real server");
-    }
     if($have_vbucket) {
         my $confua = Couchbase::Config::UA->new(
             $self->common_options->{server},
@@ -50,7 +51,6 @@ sub setup_test :Test(setup) {
     $self->cbo($cbo);
     alarm(30); #things can hang, so don't wait more than a minute for each
     #function
-    #$SIG{ALRM} = sub { diag "Alarm triggered"; die("grrr..."); }
 }
 
 sub teardown_test :Test(teardown) {
@@ -67,7 +67,7 @@ sub T40_tmpfail_basic :Test(no_plan) {
 
     note "Suspending mock server";
     $mock->suspend_process();
-    $cbo->timeout(2);
+    $cbo->timeout(0.5);
     ok(!$cbo->connect(), "Connect failed");
     my $errors = $cbo->get_errors;
     ok(scalar @$errors, "Have connection error");
@@ -83,8 +83,11 @@ sub T40_tmpfail_basic :Test(no_plan) {
 }
 
 sub T41_degraded :Test(no_plan) {
-    return; #nothing to do here unfortunately
     my $self = shift;
+
+    local $TODO = "CouchbaseMock does not have 'server-down' mode";
+    return;
+
     my $cbo = $self->cbo;
     my $mock = $self->mock;
 

perl-couchbase.h

@@ -17,8 +17,14 @@
 #error "Perl needs 64 bit integer support"
 #endif
 
+#ifndef mXPUSHs
+#define mXPUSHs(sv) XPUSHs(sv_2mortal(sv))
+#endif
+
 #include "plcb-util.h"
 
+
+
 typedef struct PLCB_st PLCB_t;
 
 typedef struct {

t/00-load.t

@@ -1,10 +1,10 @@
-#!perl -T
-
-use Test::More tests => 1;
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
 
 BEGIN {
-    use_ok( 'Couchbase::Client' ) || print "Bail out!
-";
+    use_ok('Couchbase::Client');
+    use_ok('Couchbase::Client::Async');
 }
-
-diag( "Testing Couchbase::Client $Couchbase::Client::VERSION, Perl $], $^X" );
+done_testing();