percona-toolkit/t/lib/Retry.t

#!/usr/bin/perl

BEGIN {
   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
};

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More tests => 14;

use Retry;
use PerconaTest;

my $success;
my $failure;
my $waitno;
my $tryno;
my $tries;
my $die;

my $rt = new Retry();

my $try = sub {
   if ( $die ) {
      $die = 0;
      die "I die!\n";
   }
   return $tryno++ == $tries ? "succeed" : undef;
};
my $wait = sub {
   $waitno++;
};
my $on_success = sub {
   $success = "succeed on $tryno";
};
my $on_failure = sub {
   $failure = "failed on $tryno";
};
sub try_it {
   my ( %args ) = @_;
   $success = "";
   $failure = "";
   $waitno  = $args{wainot} || 0;
   $tryno   = $args{tryno}  || 1;
   $tries   = $args{tries}  || 3;

   return $rt->retry(
      try          => $try,
      wait         => $wait,
      on_success   => $on_success,
      on_failure   => $on_failure,
      retry_on_die => $args{retry_on_die},
   );
}

my $retval = try_it();
is(
   $retval,
   "succeed",
   "Retry succeeded"
);

is(
   $success,
   "succeed on 4",
   "Called on_success code"
);

is(
   $waitno,
   2,
   "Called wait code"
);

# Default tries is 3 so allowing ourself 4 tries will cause the retry
# to fail and the on_failure code should be called.
$retval = try_it(tries=>4);
ok(
   !defined $retval,
   "Returned undef on failure"
);

is(
   $failure,
   "failed on 4",
   "Called on_failure code"
);

is(
   $success,
   "",
   "Did not call on_success code"
);

# Test what happens if the try code dies.  try_it() will reset $die to 0.
$die = 1;
eval { try_it(); };
is(
   $EVAL_ERROR,
   "I die!\n",
   "Dies if code dies without retry_on_die"
);

ok(
   !defined $retval,
   "Returned undef on try die"
);

is(
   $failure,
   "",
   "Did not call on_failure code on try die without retry_on_die"
);

is(
   $success,
   "",
   "Did not call on_success code"
);

# Test retry_on_die.  This should work with tries=2 because the first
# try will die leaving with only 2 more retries.
$die = 1;
$retval = try_it(retry_on_die=>1, tries=>2);
is(
   $retval,
   "succeed",
   "Retry succeeded with retry_on_die"
);

is(
   $success,
   "succeed on 3",
   "Called on_success code with retry_on_die"
);

is(
   $waitno,
   2,
   "Called wait code with retry_on_die"
);

# #############################################################################
# Done.
# #############################################################################
my $output = '';
{
   local *STDERR;
   open STDERR, '>', \$output;
   $rt->_d('Complete test coverage');
}
like(
   $output,
   qr/Complete test coverage/,
   '_d() works'
);
exit;