File: 11-timeout.t

package info (click to toggle)
libredis-fast-perl 0.37%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 504 kB
  • sloc: perl: 2,866; makefile: 7
file content (37 lines) | stat: -rw-r--r-- 1,057 bytes parent folder | download | duplicates (2)
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
#!perl

use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Redis::Fast;
use lib 't/tlib';
use Test::SpawnRedisTimeoutServer;
use Errno qw(ETIMEDOUT EWOULDBLOCK);
use POSIX qw(strerror);
use Carp;
use IO::Socket::INET;
use Test::TCP;
use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);

subtest 'server replies quickly enough' => sub {
    my $server = Test::SpawnRedisTimeoutServer::create_server_with_timeout(0);
    my $redis = Redis::Fast->new(server => '127.0.0.1:' . $server->port, read_timeout => 1);
    ok($redis);
    my $res = $redis->get('foo');;
    is $res, 42;
};

subtest "server doesn't replies quickly enough" => sub {
    my $server = Test::SpawnRedisTimeoutServer::create_server_with_timeout(10);
    my $redis = Redis::Fast->new(server => '127.0.0.1:' . $server->port, read_timeout => 1);
    ok($redis);
    like(
         exception { $redis->get('foo'); },
         qr/Error while reading from Redis server: /,
         "the code died as expected",
        );
    ok($! == ETIMEDOUT || $! == EWOULDBLOCK);
};

done_testing;