1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
#!/usr/bin/env perl
use strict;
use warnings FATAL => 'all';
use Test::More 0.88;
use Test::Deep;
use Test::Fatal 'exception';
use Test::Deep::UnorderedPairs;
use Test::Mock::Redis ();
use lib 't/tlib';
ok(my $r = Test::Mock::Redis->new, 'pretended to connect to our test redis-server');
my @redi = ($r);
my ( $guard, $srv );
if( $ENV{RELEASE_TESTING} ){
use_ok("Redis");
use_ok("Test::SpawnRedisServer");
($guard, $srv) = redis();
ok(my $r = Redis->new(server => $srv), 'connected to our test redis-server');
$r->flushall;
unshift @redi, $r
}
foreach my $redis (@redi)
{
diag("testing $redis") if $ENV{RELEASE_TESTING};
ok($redis->ping, 'ping');
is(
$redis->hmset(
'pipeline_key_1', qw(a 1 b 2),
sub { cmp_deeply(\@_, [ 'OK', undef ], 'hmset callback') },
),
'1',
'hmset command sent',
);
is(
$redis->set(
'pipeline_key_2', 'ohhai',
sub { cmp_deeply(\@_, [ 'OK', undef ], 'set callback') },
),
'1',
'set command sent',
);
is(
$redis->keys(
'pipeline_key_*',
sub { cmp_deeply(\@_, [ bag(qw(pipeline_key_1 pipeline_key_2)), undef ], 'keys callback') },
),
'1',
'keys operation sent',
);
cmp_deeply(
[
$redis->hgetall(
'pipeline_key_1',
sub { cmp_deeply(\@_, [ tuples(a => 1, b => 2), undef ], 'hgetall callback') },
),
],
[ '1' ],
'hgetall operation sent (wantarray=1)',
);
is(
$redis->hset(
'pipeline_key_2', 'bar', '9',
# weird, when pipelining, the real redis doesn't always include the command name?
sub { cmp_deeply(\@_, [ undef, re(qr/^(\[hset\] )?WRONGTYPE Operation against a key holding the wrong kind of value/) ], 'hset callback') },
),
'1',
'hset operation sent',
);
# flush all outstanding commands and test their callbacks
$redis->wait_all_responses;
TODO: {
# this may be officially supported eventually -- see
# https://github.com/melo/perl-redis/issues/17
local $TODO = 'Redis.pm docs recommend avoiding transactions + pipelining for now';
is(
exception {
$redis->multi;
is($redis->set('pipeline_key_2', 'ohhai'), 'QUEUED', 'set command queued inside a transaction');
is(
$redis->exec(sub {
cmp_deeply(
\@_,
[
[
[ 'OK', undef ], # result, error from 'set' call
],
undef,
],
'callback sent arrayref of result/error tuples from the transaction',
)
}),
'1',
'exec command sent',
);
$redis->wait_all_responses;
},
undef,
'exec in a pipeline is supported',
);
}
}
done_testing;
|
