The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::Most 0.22;
use lib 't';
use RedisServer;
use RedisDB;

# This test is derived from basic_redis to preserve
# tests for deprecated send_command_cb method

my $server = RedisServer->start;
plan( skip_all => "Can't start redis-server" ) unless $server;
my $redis = RedisDB->new( host => 'localhost', port => $server->{port} );

# Test callbacks
my @replies;
sub cb {
    shift;
    push @replies, [ @_ ];
}

$redis->send_command_cb('SET', 'CB A', 'AAA');
$redis->send_command_cb('GET', 'CB A', \&cb);
$redis->send_command_cb('SET', 'CB B', 'BBB');
$redis->send_command_cb('GET', 'CB B', \&cb);
is $redis->ping, "PONG", "can execute while sent some commands with callbacks";
$redis->send_command_cb('RPUSH', 'CB LIST', 'CCC');
$redis->send_command_cb('RPUSH', 'CB LIST', 'DDD');
$redis->send_command('RPUSH', 'CB LIST', 'EEE');
$redis->send_command_cb('LRANGE', 'CB LIST', 0, 3, sub { my $redis = shift; cb($redis, 'LIST', @_) } );
is $redis->replies_to_fetch, 1, "One reply to fetch";
is $redis->get_reply, 3, "Added 3 elements to the list";
$redis->send_command('PING');
is $redis->get_reply, 'PONG', "Pinged server";
eq_or_diff \@replies,
  [ [qw(AAA)], [qw(BBB)], [ 'LIST', [qw(CCC DDD EEE)] ], ],
  "Callback was called with correct arguments";
is $redis->replies_to_fetch, 0, "No replies to fetch";

done_testing;