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
|
use strict;
use warnings;
use Test::More;
my $fail;
BEGIN {
eval "use Devel::LeakGuard::Object qw(leakguard)";
$fail = $@;
}
plan skip_all => 'Need Devel::LeakGuard::Object' if $fail;
plan tests => 3;
use Net::XMPP;
check_leak(
sub {
my $x = bless {}, 'abc';
},
'nothing',
);
TODO: {
local $TODO = 'fix leak';
check_leak(
sub {
my $conn = Net::XMPP::Client->new;
$conn = undef;
},
'new',
);
check_leak(
sub {
my $conn = Net::XMPP::Client->new;
my $status = $conn->Connect(
hostname => 'talk.google.com',
port => 5222,
componentname => 'gmail.com',
connectiontype => 'tcpip',
tls => 1,
ssl_verify => 0,
);
},
'connect',
);
}
sub check_leak{
my ($sub) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $c (1..10) {
$sub->();
}
my $warn;
local $SIG{__WARN__} = sub { $warn = shift };
leakguard {
for my $c (1..10) {
$sub->();
#diag "Called $c";
}
};
ok(!$warn, 'leaking') or diag $warn;
}
|
