From b19ed93d00099bb2864575052a15a683d36ccb1d Mon Sep 17 00:00:00 2001 From: Mark Nunberg Date: Thu, 9 Feb 2012 21:06:54 -0800 Subject: [PATCH] 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 | 2 -- lib/Couchbase/MockServer.pm | 17 ++++++++++---- lib/Couchbase/Test/Async.pm | 14 +++++++++--- lib/Couchbase/Test/Async/Loop.pm | 2 +- lib/Couchbase/Test/ClientSync.pm | 2 +- lib/Couchbase/Test/Common.pm | 24 ++++++++++++++++---- lib/Couchbase/Test/Interop.pm | 39 +++++++++++++------------------- lib/Couchbase/Test/Netfail.pm | 15 +++++++----- perl-couchbase.h | 6 +++++ t/00-load.t | 14 ++++++------ 10 files changed, 83 insertions(+), 52 deletions(-) diff --git a/lib/Couchbase/Client.pm b/lib/Couchbase/Client.pm index b409f04..e90c426 100644 --- a/lib/Couchbase/Client.pm +++ b/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 { diff --git a/lib/Couchbase/MockServer.pm b/lib/Couchbase/MockServer.pm index 782773c..e60279c 100644 --- a/lib/Couchbase/MockServer.pm +++ b/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); diff --git a/lib/Couchbase/Test/Async.pm b/lib/Couchbase/Test/Async.pm index ac45c3c..6657c69 100644 --- a/lib/Couchbase/Test/Async.pm +++ b/lib/Couchbase/Test/Async.pm @@ -4,22 +4,29 @@ 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; @@ -27,6 +34,7 @@ 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!"; }, diff --git a/lib/Couchbase/Test/Async/Loop.pm b/lib/Couchbase/Test/Async/Loop.pm index 1d9f6b4..b5c6bca 100644 --- a/lib/Couchbase/Test/Async/Loop.pm +++ b/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"); } } } diff --git a/lib/Couchbase/Test/ClientSync.pm b/lib/Couchbase/Test/ClientSync.pm index 9a8a099..43462a3 100644 --- a/lib/Couchbase/Test/ClientSync.pm +++ b/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)) diff --git a/lib/Couchbase/Test/Common.pm b/lib/Couchbase/Test/Common.pm index b35f8fb..65af0c0 100644 --- a/lib/Couchbase/Test/Common.pm +++ b/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; } } diff --git a/lib/Couchbase/Test/Interop.pm b/lib/Couchbase/Test/Interop.pm index 4e89c5a..503f4fa 100644 --- a/lib/Couchbase/Test/Interop.pm +++ b/lib/Couchbase/Test/Interop.pm @@ -7,7 +7,7 @@ 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; @@ -15,24 +15,19 @@ 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"); } diff --git a/lib/Couchbase/Test/Netfail.pm b/lib/Couchbase/Test/Netfail.pm index 1480737..7424f92 100644 --- a/lib/Couchbase/Test/Netfail.pm +++ b/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; diff --git a/perl-couchbase.h b/perl-couchbase.h index a8f0773..42d6e72 100644 --- a/perl-couchbase.h +++ b/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 { diff --git a/t/00-load.t b/t/00-load.t index 0678234..96fe1a8 100644 --- a/t/00-load.t +++ b/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();