#!perl
#
# borrowed from Redis.pm's test suite with permission
#
use warnings;
use strict;
use lib 't/tlib';
use Test::More;
use Test::Fatal;
use Test::Mock::Redis;
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 $o (@redi){
diag("testing $o") if $ENV{RELEASE_TESTING};
ok($o->ping, 'ping');
## Commands operating on string values
ok($o->set(foo => 'bar'), 'set foo => bar');
ok(!$o->setnx(foo => 'bar'), 'setnx foo => bar fails');
cmp_ok($o->get('foo'), 'eq', 'bar', 'get foo = bar');
ok($o->set(foo => ''), 'set foo => ""');
cmp_ok($o->get('foo'), 'eq', '', 'get foo = ""');
ok($o->set(foo => 'baz'), 'set foo => baz');
cmp_ok($o->get('foo'), 'eq', 'baz', 'get foo = baz');
my $euro = "\x{20ac}";
ok($o->set(utf8 => $euro), 'set utf8');
cmp_ok($o->get('utf8'), 'eq', $euro, 'get utf8');
ok($o->set('test-undef' => 42), 'set test-undef');
ok($o->exists('test-undef'), 'exists undef');
# Big sized keys
for my $size (10_000, 100_000, 500_000, 1_000_000, 2_500_000) {
my $v = 'a' x $size;
ok($o->set('big_key', $v), "set with value size $size ok");
is($o->get('big_key'), $v, "... and get was ok to");
}
$o->del('non-existant');
ok(!$o->exists('non-existant'), 'exists non-existant');
ok(!defined $o->get('non-existant'), 'get non-existant');
my $key_next = 3;
ok($o->set('key-next' => 0), 'key-next = 0');
ok($o->set('key-left' => $key_next), 'key-left');
is_deeply([$o->mget('foo', 'key-next', 'key-left')], ['baz', 0, 3], 'mget');
my @keys;
foreach my $id (0 .. $key_next) {
my $key = 'key-' . $id;
push @keys, $key;
ok($o->set($key => $id), "set $key");
ok($o->exists($key), "exists $key");
is($o->get($key), $id, "get $key");
cmp_ok($o->incr('key-next'), '==', $id + 1, 'incr');
cmp_ok($o->decr('key-left'), '==', $key_next - $id - 1, 'decr');
}
is($o->get('key-next'), $key_next + 1, 'key-next');
ok($o->set('test-incrby', 0), 'test-incrby');
ok($o->set('test-decrby', 0), 'test-decry');
foreach (1 .. 3) {
is($o->incrby('test-incrby', 3), $_ * 3, 'incrby 3');
is($o->decrby('test-decrby', 7), -($_ * 7), 'decrby 7');
}
is($o->del(map {"key-$_"} ('next', 'left')), 2, 'del multiple keys');
ok(!$o->del('non-existing'), 'del non-existing');
is($o->type('zzzzzzz'), 'none', 'type of non-existent key');
cmp_ok($o->type('foo'), 'eq', 'string', 'type');
is($o->keys('key-*'), $key_next + 1, 'key-*');
is_deeply([sort $o->keys('key-*')], [sort @keys], 'keys');
ok(my $key = $o->randomkey, 'randomkey');
ok($o->rename('test-incrby', 'test-renamed'), 'rename');
ok($o->exists('test-renamed'), 'exists test-renamed');
eval { $o->rename('test-decrby', 'test-renamed', 1) };
ok($@, 'rename to existing key');
ok(my $nr_keys = $o->dbsize, 'dbsize');
## Commands operating on lists
my $list = 'test-list';
$o->del($list);
ok($o->rpush($list => "r$_"), 'rpush') foreach (1 .. 3);
ok($o->lpush($list => "l$_"), 'lpush') foreach (1 .. 2);
cmp_ok($o->type($list), 'eq', 'list', 'type');
cmp_ok($o->llen($list), '==', 5, 'llen');
is_deeply([$o->lrange($list, 0, 1)], ['l2', 'l1'], 'lrange');
ok($o->ltrim($list, 1, 2), 'ltrim');
cmp_ok($o->llen($list), '==', 2, 'llen after ltrim');
cmp_ok($o->lindex($list, 0), 'eq', 'l1', 'lindex');
cmp_ok($o->lindex($list, 1), 'eq', 'r1', 'lindex');
ok($o->lset($list, 0, 'foo'), 'lset');
cmp_ok($o->lindex($list, 0), 'eq', 'foo', 'verified');
ok($o->lrem($list, 1, 'foo'), 'lrem');
cmp_ok($o->llen($list), '==', 1, 'llen after lrem');
cmp_ok($o->lpop($list), 'eq', 'r1', 'lpop');
ok(!$o->rpop($list), 'rpop');
## Commands operating on sets
my $set = 'test-set';
$o->del($set);
ok($o->sadd($set, 'foo'), 'sadd');
ok(!$o->sadd($set, 'foo'), 'sadd');
cmp_ok($o->scard($set), '==', 1, 'scard');
ok($o->sismember($set, 'foo'), 'sismember');
cmp_ok($o->type($set), 'eq', 'set', 'type is set');
ok($o->srem($set, 'foo'), 'srem');
ok(!$o->srem($set, 'foo'), 'srem again');
cmp_ok($o->scard($set), '==', 0, 'scard');
$o->sadd('test-set1', $_) foreach ('foo', 'bar', 'baz');
$o->sadd('test-set2', $_) foreach ('foo', 'baz', 'xxx');
my $inter = ['foo', 'baz'];
is_deeply([sort $o->sinter('test-set1', 'test-set2')], [sort @$inter], 'siter');
ok($o->sinterstore('test-set-inter', 'test-set1', 'test-set2'),
'sinterstore');
cmp_ok(
$o->scard('test-set-inter'),
'==',
$#$inter + 1,
'cardinality of intersection'
);
## Commands operating on zsets (sorted sets)
# TODO: ZUNIONSTORE, ZINTERSTORE, SORT, tests w/multiple values having the same score
my $zset = 'test-zset';
$o->del($zset);
ok($o->zadd($zset, 0, 'foo'));
ok(!$o->zadd($zset, 1, 'foo')); # 0 returned because foo is already in the set
is($o->zscore($zset, 'foo'), 1);
ok($o->zincrby($zset, 1, 'foo'));
is($o->zscore($zset, 'foo'), 2);
ok($o->zincrby($zset, 1, 'bar'));
is($o->zscore($zset, 'bar'), 1)
; # bar was new, so its score got set to the increment
is($o->zrank($zset, 'bar'), 0);
is($o->zrank($zset, 'foo'), 1);
is($o->zrevrank($zset, 'bar'), 1);
is($o->zrevrank($zset, 'foo'), 0);
ok($o->zadd($zset, 2.1, 'baz')); # we now have bar foo baz
is_deeply([$o->zrange($zset, 0, 1)], [qw/bar foo/]);
is_deeply([$o->zrevrange($zset, 0, 1)], [qw/baz foo/]);
my $withscores = {$o->zrevrange($zset, 0, 1, 'WITHSCORES')};
# this uglyness gets around floating point weirdness in the return (I.E. 2.1000000000000001);
my $rounded_withscores = {
map { $_ => 0 + sprintf("%0.5f", $withscores->{$_}) }
keys %$withscores
};
is_deeply($rounded_withscores, {baz => 2.1, foo => 2});
is_deeply([$o->zrangebyscore($zset, 2, 3)], [qw/foo baz/]);
is($o->zcount($zset, 2, 3), 2);
is($o->zcard($zset), 3);
ok($o->del($zset)); # cleanup
my $score = 0.1;
my @zkeys = (qw/foo bar baz qux quux quuux quuuux quuuuux/);
ok($o->zadd($zset, $score++, $_)) for @zkeys;
is_deeply([$o->zrangebyscore($zset, 0, 8)], \@zkeys);
is($o->zremrangebyrank($zset, 5, 8), 3); # remove quux and up
is_deeply([$o->zrangebyscore($zset, 0, 8)], [@zkeys[0 .. 4]]);
is($o->zremrangebyscore($zset, 0, 2), 2); # remove foo and bar
is_deeply([$o->zrangebyscore($zset, 0, 8)], [@zkeys[2 .. 4]]);
# only left with 3
is($o->zcard($zset), 3);
ok($o->del($zset)); # cleanup
my @sorting_zkeys = (qw/foog foof fooe fooa foob food fooc/);
# foo* all have the same score so they should sort lexically
$o->zadd($zset, 1, 'bar');
ok($o->zadd($zset, 5, $_)) for @sorting_zkeys;
$o->zadd($zset, 9, 'baz');
my @sorted_zkeys = sort @sorting_zkeys;
@sorting_zkeys = ('bar', @sorting_zkeys, 'baz');
@sorted_zkeys = ('bar', @sorted_zkeys, 'baz');
is_deeply([$o->zrangebyscore($zset, 0, 10)], \@sorted_zkeys);
is_deeply([$o->zrangebyscore($zset, 0, 4)], [ 'bar' ]);
is_deeply([$o->zrangebyscore($zset, 2, 6)], [@sorted_zkeys[1..7]]);
my @revsorted_zkeys = reverse @sorted_zkeys;
# max and min are reversed
is_deeply([$o->zrevrangebyscore($zset, 10, 0)], \@revsorted_zkeys);
is_deeply([$o->zrevrangebyscore($zset, 4, 0)], [ 'bar' ]);
is_deeply([$o->zrevrangebyscore($zset, 6, 2)], [@revsorted_zkeys[1..7]]);
# test withscores
my $expected_withscores = [ map { $_, 5} @revsorted_zkeys ];
# (fix up bar =>1 and baz => 9 by hand)
$expected_withscores->[-1] = 1;
$expected_withscores->[1] = 9;
is_deeply([$o->zrevrangebyscore($zset, 10, 0, 'WITHSCORES')], $expected_withscores);
ok($o->del($zset)); # cleanup
## Commands operating on hashes
my $hash = 'test-hash';
$o->del($hash);
ok($o->hset($hash, foo => 'bar'));
is($o->hget($hash, 'foo'), 'bar');
ok($o->hexists($hash, 'foo'));
ok($o->hdel($hash, 'foo'));
ok(!$o->hexists($hash, 'foo'));
ok($o->hincrby($hash, incrtest => 1));
is($o->hget($hash, 'incrtest'), 1);
is($o->hincrby($hash, incrtest => -1), 0);
is($o->hget($hash, 'incrtest'), 0);
ok($o->hdel($hash, 'incrtest')); #cleanup
ok($o->hsetnx($hash, setnxtest => 'baz'));
ok(!$o->hsetnx($hash, setnxtest => 'baz')); # already exists, 0 returned
ok($o->hdel($hash, 'setnxtest')); #cleanup
ok($o->hmset($hash, foo => 1, bar => 2, baz => 3, qux => 4));
is_deeply([$o->hmget($hash, qw/foo bar baz/)], [1, 2, 3]);
is($o->hlen($hash), 4);
is_deeply([sort $o->hkeys($hash)], [sort qw/foo bar baz qux/]);
is_deeply([sort $o->hvals($hash)], [sort qw/1 2 3 4/]);
is_deeply({$o->hgetall($hash)}, {foo => 1, bar => 2, baz => 3, qux => 4});
ok($o->del($hash)); # remove entire hash
## Multiple databases handling commands
ok($o->select(1), 'select');
ok($o->select(0), 'select');
ok($o->move('foo', 1), 'move');
ok(!$o->exists('foo'), 'gone');
ok($o->select(1), 'select');
ok($o->exists('foo'), 'exists');
ok($o->flushdb, 'flushdb');
cmp_ok($o->dbsize, '==', 0, 'empty');
## Sorting
ok($o->lpush('test-sort', $_), "put $_") foreach (1 .. 4);
cmp_ok($o->llen('test-sort'), '==', 4, 'llen');
is_deeply([$o->sort('test-sort')], [1, 2, 3, 4], 'sort');
is_deeply([$o->sort('test-sort', 'DESC')], [4, 3, 2, 1], 'sort DESC');
## "Persistence control commands"
ok($o->save, 'save');
ok($o->bgsave, 'bgsave');
ok($o->lastsave, 'lastsave');
#ok( $o->shutdown, 'shutdown' );
## Remote server control commands
ok(my $info = $o->info, 'info');
isa_ok($info, 'HASH');
## Connection handling
ok($o->ping, 'ping() is true');
ok($o->quit, 'quit');
ok(!$o->ping, '... but after quit() returns false');
my $type = ref $o;
$srv ||= 'localhost';
$o = $type->new(server => $srv);
$o->shutdown();
ok(!$o->ping(), 'ping() also false after shutdown()');
sleep(1);
like exception { $type->new(server => $srv) },
qr/Could not connect to Redis server at $srv/,
'Failed connection throws exception';
}
## All done
done_testing();