File: 20-memleak.t

package info (click to toggle)
libcassandra-client-perl 0.21-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 716 kB
  • sloc: perl: 3,898; ansic: 1,767; makefile: 3
file content (153 lines) | stat: -rw-r--r-- 3,542 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
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
144
145
146
147
148
149
150
151
152
153
#!perl
use 5.010;
use strict;
use warnings;
use File::Basename qw//; use lib File::Basename::dirname(__FILE__).'/lib';
use Test::More;
use TestCassandra;
use Cassandra::Client::Util qw/series parallel/;
use Scalar::Util 'weaken';
use Socket qw/PF_INET SOCK_STREAM/;
use Devel::Cycle;
use Data::Dumper;

plan skip_all => "Missing Cassandra test environment" unless TestCassandra->is_ok;
plan tests => 14;

{
    # Weaken() sanity
    my $h= {};
    weaken($h);
    ok(!$h) or diag("Our weaken() sucks.");
}

sub get_fd_sequence {
    my ($count)= @_;
    my @sockets;
    for (1..$count) {
        socket(my $sock, PF_INET, SOCK_STREAM, 0) or die $!;
        push @sockets, $sock;
    }

    my @sequence;
    while (my $sock= shift @sockets) {
        push @sequence, fileno($sock);
        close($sock);
    }

    return @sequence;
}

my $deinit;
BEGIN {
    no warnings;
    no strict 'refs';
    my $destroy= *{"Cassandra::Client::DESTROY"}{CODE};
    *Cassandra::Client::DESTROY= sub {
        $deinit= 1;
        goto &$destroy;
    };
}

my @fd_sequence_init= get_fd_sequence(100);
my @fd_sequence_init2= get_fd_sequence(100);

my $client= TestCassandra->new;
$client->connect();

my $db= 'perl_cassandra_client_tests';
$client->execute("create keyspace if not exists $db with replication={'class':'SimpleStrategy', 'replication_factor': 1}");
$client->execute("create table if not exists $db.test_int (id int primary key, value int)");
$client->execute("insert into $db.test_int (id, value) values (5, 6)");
{
    my ($result)= $client->execute("select id, value from $db.test_int where id=5");
    my $rows= $result->rows;
    ok(@$rows == 1);
    ok($rows->[0][0] == 5);
    ok($rows->[0][1] == 6);
}

$client->execute("delete from $db.test_int where id=5");
{
    my ($result)= $client->execute("select id, value from $db.test_int where id=5");
    my $rows= $result->rows;
    ok(@$rows == 0);
}

my @conns= values %{$client->{pool}{pool}};
weaken $_ for @conns;
ok(0+(grep $_, @conns));

ok(!$deinit);
$client->shutdown if rand() < 0.5;
weaken $client;
ok($deinit);

ok(!grep $_, @conns);

my @fd_sequence_done= get_fd_sequence(100);
if (join(',', @fd_sequence_init) ne join(',', @fd_sequence_init2)) {
    ok(1) and diag('Disabling FD sequence checker, does not seem supported');
} elsif (! -d "/proc/$$/fd") {
    ok(1) and diag('Disabling FD sequence checker, we don\'t have a useful /proc');
} else {
    my %cur= map { $_, 1 } @fd_sequence_done;
    my @mismatch= grep { !$cur{$_} } @fd_sequence_init;
    my @where= map { readlink("/proc/$$/fd/$_") } @mismatch;
    my @real_mismatch= grep /socket/, @where;
    my $count= @real_mismatch;
    ok($count == 0, "$count file handles were not closed");
}

if (!$deinit) {
    my $trivial_cycles;
    find_cycle($client, sub {
        $trivial_cycles= 1;
    });

    if ($trivial_cycles) {
        diag("Trivial cycles found, should be easy to fix.");
    } else {
        diag("No trivial cycles found, but we do have a memory leak!");
    }
}

# Test series()
{
    my $one= {};
    my $two= {};
    series([
        sub {
            shift->($one);
        },
        sub {
            shift->($one);
        },
    ], sub {
        $two->{abc}= 1;
    });

    weaken $one;
    weaken $two;
    ok(!$one);
    ok(!$two);
}

# Test parallel()
{
    my $one= {};
    my $two= {};
    parallel([
        sub { shift->($one); },
        sub { shift->($one); },
    ], sub {
        $two->{abc}= 1;
    });

    weaken $one;
    weaken $two;
    ok(!$one);
    ok(!$two);
}

1;