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