File: 11-timeout.t

package info (click to toggle)
libredis-perl 2%3A2.000-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 416 kB
  • sloc: perl: 2,695; makefile: 4
file content (96 lines) | stat: -rw-r--r-- 2,772 bytes parent folder | download
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
#!perl
#
# This file is part of Redis
#
# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
#   The Artistic License 2.0 (GPL Compatible)
#

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

use constant SSL_AVAILABLE => eval { require IO::Socket::SSL } || 0;

subtest 'server replies quickly enough' => sub {
    my $server = Test::SpawnRedisTimeoutServer::create_server_with_timeout(0);
    my $redis = Redis->new(server => '127.0.0.1:' . $server->port,
                           read_timeout => 1,
                           ssl => SSL_AVAILABLE,
                           SSL_verify_mode => 0);
    ok($redis);
    my $res = $redis->get('foo');;
    is $res, 42, "the code didn't died, as expected";
};

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

subtest "server doesn't respond at connection (cnx_timeout)" => sub {
  SKIP: {
    skip "This subtest is failing on some platforms", 4;
	my $server = Test::TCP->new(code => sub {
            my $port = shift;

            my %args = (
                Listen    => 1,
                LocalPort => $port,
                LocalAddr => '127.0.0.1',
            );

            my $socket_class = 'IO::Socket::INET';

            if ( SSL_AVAILABLE ) {
                $socket_class = 'IO::Socket::SSL';

                $args{SSL_cert_file} = 't/stunnel/cert.pem';
                $args{SSL_key_file}  = 't/stunnel/key.pem';
            }

			my $sock = $socket_class->new(%args) or croak "fail to listen on port $port";
			while(1) {
				sleep(1);
			};
	});

    my $redis;
    my $start_time = time;
    isnt(
         exception { $redis = Redis->new(server => '127.0.0.1:' . $server->port,
                                         cnx_timeout => 1,
                                         ssl => SSL_AVAILABLE, SSL_verify_mode => 0); },
         undef,
         "the code died",
        );
    ok(time - $start_time >= 1, "gave up late enough");
    ok(time - $start_time < 5, "gave up soon enough");
    ok(!$redis, 'redis was not set');
  }
};

done_testing;