1#!perl 2 3use warnings; 4use strict; 5use Test::More; 6use Test::Fatal; 7use Redis::Fast; 8use lib 't/tlib'; 9use Test::SpawnRedisServer; 10use Test::Deep; 11 12my ($c, $srv) = redis(); 13END { $c->() if $c } 14{ 15my $r = Redis::Fast->new(server => $srv); 16eval { $r->multi( ); }; 17plan 'skip_all' => "multi without arguments not implemented on this redis server" if $@ && $@ =~ /unknown command/; 18} 19 20 21ok(my $r = Redis::Fast->new(server => $srv), 'connected to our test redis-server'); 22 23sub pipeline_ok { 24 my ($desc, @commands) = @_; 25 my (@responses, @expected_responses); 26 for my $cmd (@commands) { 27 my ($method, $args, $expected, $expected_err) = @$cmd; 28 push @expected_responses, [$expected, $expected_err]; 29 $r->$method(@$args, sub { push @responses, [@_] }); 30 } 31 $r->wait_all_responses; 32 33 cmp_deeply(\@responses, \@expected_responses, $desc); 34} 35 36pipeline_ok 'single-command pipeline', ([set => [foo => 'bar'], 'OK'],); 37 38pipeline_ok 'pipeline with embedded error', 39 ([set => [clunk => 'eth'], 'OK'], [oops => [], undef, re(q[\AERR unknown command ['`]OOPS['`](:?, with args beginning with: )?\z])], [get => ['clunk'], 'eth'],); 40 41pipeline_ok 'keys in pipelined mode', 42 ([keys => ['*'], bag(qw<foo clunk>)], [keys => [], undef, q[ERR wrong number of arguments for 'keys' command]],); 43 44pipeline_ok 'info in pipelined mode', 45 ( 46 [info => [], code(sub { ref $_[0] eq 'HASH' && keys %{ $_[0] } })], 47 [ info => [qw<oops oops>], 48 undef, 49 re(qr{^ERR (?:syntax error|wrong number of arguments for 'info' command)$}) 50 ], 51 ); 52 53pipeline_ok 'pipeline with multi-bulk reply', 54 ([hmset => [kapow => (a => 1, b => 2, c => 3)], 'OK'], [hmget => [kapow => qw<c b a>], [3, 2, 1]],); 55 56pipeline_ok 'large pipeline', 57 ( 58 (map { [hset => [zzapp => $_ => -$_], 1] } 1 .. 5000), 59 [hmget => [zzapp => (1 .. 5000)], [reverse -5000 .. -1]], 60 [del => ['zzapp'], 1], 61 ); 62 63subtest 'synchronous request with pending pipeline' => sub { 64 my $clunk; 65 is($r->get('clunk', sub { $clunk = $_[0] }), 1, 'queue a request'); 66 is($r->set('kapow', 'zzapp', sub { }), 1, 'queue another request'); 67 is($r->get('kapow'), 'zzapp', 'synchronous request has expected return'); 68 is($clunk, 'eth', 'synchronous request processes pending ones'); 69}; 70 71subtest 'transaction with error and pipeline' => sub { 72 my @responses; 73 my $s = sub { push @responses, [@_] }; 74 $r->multi($s); 75 $r->set(clunk => 'eth', $s); 76 $r->rpush(clunk => 'oops', $s); 77 $r->get('clunk', $s); 78 $r->exec($s); 79 $r->wait_all_responses; 80 81 is(shift(@responses)->[0], 'OK' , 'multi started' ); 82 is(shift(@responses)->[0], 'QUEUED', 'queued'); 83 is(shift(@responses)->[0], 'QUEUED', 'queued'); 84 is(shift(@responses)->[0], 'QUEUED', 'queued'); 85 my $resp = shift @responses; 86 is ($resp->[0]->[0]->[0], 'OK', 'set'); 87 is ($resp->[0]->[1]->[0], undef, 'bad rpush value should be undef'); 88 like ($resp->[0]->[1]->[1], 89 qr/(?:ERR|WRONGTYPE) Operation against a key holding the wrong kind of value/, 90 'bad rpush should give an error'); 91 is ($resp->[0]->[2]->[0], 'eth', 'get should work'); 92}; 93 94subtest 'transaction with error and no pipeline' => sub { 95 is($r->multi, 'OK', 'multi'); 96 is($r->set('clunk', 'eth'), 'QUEUED', 'transactional SET'); 97 is($r->rpush('clunk', 'oops'), 'QUEUED', 'transactional bad RPUSH'); 98 is($r->get('clunk'), 'QUEUED', 'transactional GET'); 99 like( 100 exception { $r->exec }, 101 qr{\[exec\] (?:WRONGTYPE|ERR) Operation against a key holding the wrong kind of value,}, 102 'synchronous EXEC dies for intervening error' 103 ); 104}; 105 106 107subtest 'wait_one_response' => sub { 108 plan skip_all => 'hiredis cannot wait_one_response'; 109 my $first; 110 my $second; 111 112 $r->get('a', sub { $first++ }); 113 $r->get('a', sub { $second++ }); 114 $r->get('a', sub { $first++ }); 115 $r->get('a', sub { $second++ }); 116 117 $r->wait_one_response(); 118 is($first, 1, 'after first wait_one_response(), first callback called'); 119 is($second, undef, '... but not the second one'); 120 121 $r->wait_one_response(); 122 is($first, 1, 'after second wait_one_response(), first callback was not called again'); 123 is($second, 1, '... but the second one was called'); 124 125 $r->wait_all_responses(); 126 is($first, 2, 'after final wait_all_responses(), first callback was called again'); 127 is($second, 2, '... the second one was also called'); 128 129 $r->wait_one_response(); 130 is($first, 2, 'after final wait_one_response(), first callback was not called again'); 131 is($second, 2, '... nor was the second one'); 132}; 133 134 135done_testing(); 136