$|=1;
use strict;
use warnings;
use DBI;
use Data::Dumper;
use Test::More;
sub between_ok;
plan skip_all => "requires Callbacks which are not supported with PurePerl" if $DBI::PurePerl;
if (my $ap = $ENV{DBI_AUTOPROXY}) { plan skip_all => "Gofer DBI_AUTOPROXY" if $ap =~ /^dbi:Gofer/i;
warn "\n$0 is running with DBI_AUTOPROXY enabled ($ENV{DBI_AUTOPROXY})\n"
unless $0 =~ /\bzv/; }
plan 'no_plan';
my $tmp;
my $dbh;
my $fails;
my @warns;
$SIG{__WARN__} = sub { ("@_" =~ /^DBI_GOFER_RANDOM/) ? push(@warns, @_) : warn @_; };
($fails, $dbh) = trial_impact("fail=100%,do", 10, "", sub { $_->do("set foo=1") });
is $fails, 100, 'should fail 100% of the time';
ok $@, '$@ should be set';
like $@, '/fake error from do method induced by DBI_GOFER_RANDOM/';
ok $dbh->errstr, 'errstr should be set';
like $dbh->errstr, '/DBI_GOFER_RANDOM/', 'errstr should contain DBI_GOFER_RANDOM';
ok !$dbh->{go_response}->executed_flag_set, 'go_response executed flag should be false';
srand(42);
sub trial_impact {
my ($spec, $count, $dsn_attr, $code, $verbose) = @_;
local $ENV{DBI_GOFER_RANDOM} = $spec;
my $dbh = dbi_connect("policy=rush;$dsn_attr");
local $_ = $dbh;
my $fail_percent = percentage_exceptions(200, $code, $verbose);
return $fail_percent unless wantarray;
return ($fail_percent, $dbh);
}
$fails = trial_impact("fail=50%,do", 200, "retry_limit=0", sub { $_->do("set foo=1") });
print "target approx 50% random failures, got $fails%\n";
between_ok $fails, 10, 90, "should fail about 50% of the time, but at least between 10% and 90%";
$fails = trial_impact("fail=50%,prepare", 200, "retry_limit=5", sub { $_->prepare("set foo=1") });
print "target less than 20% effective random failures (ideally 0), got $fails%\n";
cmp_ok $fails, '<', 20, 'should fail < 20%';
$fails = trial_impact("fail=10,do", 200, "retry_limit=10", sub { $_->do("set foo=1") });
cmp_ok $fails, '<', 1, 'should fail < 1%';
$ENV{DBI_GOFER_RANDOM} = "fail=50%,do";
ok my $dbh_50r1ro = dbi_connect("policy=rush;retry_limit=1", {
go_retry_hook => sub { return ($_[0]->is_idempotent) ? 1 : 0 },
ReadOnly => 1,
} );
between_ok percentage_exceptions(100, sub { $dbh_50r1ro->do("set foo=1") }),
10, 40, 'should fail ~25% (ie 50% with one retry)';
between_ok $dbh_50r1ro->{go_transport}->meta->{request_retry_count},
20, 80, 'transport request_retry_count should be around 50';
ok my $dbh_50r1rw = dbi_connect("policy=rush;retry_limit=1", {
go_retry_hook => sub { return ($_[0]->is_idempotent) ? 1 : 0 },
ReadOnly => 0,
} );
between_ok percentage_exceptions(100, sub { $dbh_50r1rw->do("set foo=1") }),
20, 80, 'should fail ~50%, ie no retries';
ok !$dbh_50r1rw->{go_transport}->meta->{request_retry_count},
'transport request_retry_count should be zero or undef';
my %fail_percents;
for (1..5) {
$fails = trial_impact("fail=50%,do", 10, "", sub { $_->do("set foo=1") });
++$fail_percents{$fails};
}
cmp_ok scalar keys %fail_percents, '>=', 2, 'positive percentage should fail randomly';
%fail_percents = ();
for (1..5) {
$fails = trial_impact("fail=-50%,do", 10, "", sub { $_->do("set foo=1") });
++$fail_percents{$fails};
}
is scalar keys %fail_percents, 1, 'negative percentage should fail non-randomly';
print "Testing random delay\n";
$ENV{DBI_GOFER_RANDOM} = "delay0.1=51%,do"; @warns = ();
ok $dbh = dbi_connect("policy=rush;retry_limit=0");
is percentage_exceptions(20, sub { $dbh->do("set foo=1") }),
0, "should not fail for DBI_GOFER_RANDOM='$ENV{DBI_GOFER_RANDOM}'";
my $delays = grep { m/delaying execution/ } @warns;
between_ok $delays, 1, 19, 'should be delayed around 5 times';
exit 0;
sub between_ok {
my ($got, $min, $max, $label) = @_;
local $Test::Builder::Level = 2;
cmp_ok $got, '>=', $min, "$label (got $got)";
cmp_ok $got, '<=', $max, "$label (got $got)";
}
sub dbi_connect {
my ($gdsn, $attr) = @_;
return DBI->connect("dbi:Gofer:transport=null;$gdsn;dsn=dbi:ExampleP:", 0, 0, {
RaiseError => 1, PrintError => 0, ($attr) ? %$attr : ()
});
}
sub percentage_exceptions {
my ($count, $sub, $verbose) = @_;
my $i = $count;
my $exceptions = 0;
while ($i--) {
eval { $sub->() };
warn sprintf("percentage_exceptions $i: %s\n", $@|| $DBI::errstr || '') if $verbose;
if ($@) {
die "Unexpected failure: $@" unless $@ =~ /DBI_GOFER_RANDOM/;
++$exceptions;
}
}
warn sprintf "percentage_exceptions %f/%f*100 = %f\n",
$exceptions, $count, $exceptions/$count*100
if $verbose;
return $exceptions/$count*100;
}