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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
#!/usr/bin/env perl
use strict;
use warnings;
use lib 't/tlib';
use Test::More;
use Test::Mock::Redis;
=pod
x AUTH
x ECHO
x PING
x QUIT
o SELECT <-- TODO: complain about invalid values?
BGREWRITEAOF
BGSAVE
CONFIG GET
CONFIG RESETSTAT
CONFIG SET
DBSIZE
DEBUG OBJECT
DEBUG SEGFAULT
x FLUSHALL
x FLUSHDB
o INFO
x LASTSAVE
MONITOR
x SAVE
o SHUTDOWN
SLAVEOF
SYNC
=cut
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 $r (@redi){
diag("testing $r") if $ENV{RELEASE_TESTING};
ok($r->ping, 'ping returns PONG');
ok($r->select($_), "select returns true for $_") for 0..15;
$r->select(0);
# TODO: do we care?
eval{ $r->auth };
like($@, qr/^\Q[auth] ERR wrong number of arguments for 'auth' command\E/, 'auth without a password dies');
# as of redis 2.6 (?) this fails when auth is not enabled on the server
# eval{ $r->auth('foo') };
# like($@, qr/^\Q[auth] ERR Client sent AUTH, but no password is set\E/, 'auth when no password set dies');
# however, emulating this behavior is not likely to be useful - better to silently
# pretend that any auth worked than throw an error.
for(0..15){
$r->select($_);
$r->set('foo', "foobar $_");
is($r->get('foo'), "foobar $_");
}
ok($r->flushall);
for(0..15){
$r->select($_);
ok(! $r->exists('foo'), "foo flushed from db$_");
}
for my $flush_db (0..15){
for(0..15){
$r->select($_);
$r->set('foo', "foobar $_");
is($r->get('foo'), "foobar $_");
}
$r->select($flush_db);
$r->flushdb;
ok(! $r->exists('foo'), "foo flushed from db$flush_db");
for(0..15){
next if $_ == $flush_db;
$r->select($_);
ok($r->exists('foo'), "foo not flushed from db$_");
}
}
$r->select(0); # go back to db0
like($r->lastsave, qr/^\d+$/, 'lastsave returns digits');
ok($r->save, 'save returns true');
like($r->lastsave, qr/^\d+$/, 'lastsave returns digits');
my $info = $r->info;
is(ref $info, 'HASH', 'info returned a hash');
#use Data::Dumper; diag Dumper $info;
like($info->{run_id},qr/^[0-9a-f]{40}/, 'run_id is 40 random hex chars');
for(0..14){
is($info->{"db$_"}, 'keys=1,expires=0,avg_ttl=0', "db$_ info is correct");
}
# db15 was left with nothing in it, since it was the last one flushed
is($info->{"db15"}, undef, 'info returns no data about databases with no keys');
$r->setex("volitile-key-$_", 15, 'some value') for (1..5);
like $r->info->{'db0'}, qr/^keys=6,expires=5,avg_ttl=\d+$/,
'db0 info now has six keys and five expires';
ok($r->quit, 'quit returns true');
ok(!$r->quit, 'quit returns false the second time');
ok(! $r->ping, 'ping returns false after we quit');
my $type = ref $r;
my $r2 = $type->new(server => $srv);
ok($r2->ping, 'we can ping our new redis client');
$r2->shutdown; # doesn't return anything
ok(! $r2->ping, 'ping returns false after we shutdown');
}
done_testing();
|
