Commit | Line | Data |
---|---|---|
d97c33b5 DM |
1 | #!./perl |
2 | ||
3 | # A place to put some simple leak tests. Uses XS::APItest to make | |
4 | # PL_sv_count available, allowing us to run a bit a code multiple times and | |
5 | # see if the count increases. | |
6 | ||
7 | BEGIN { | |
8 | chdir 't'; | |
9 | @INC = '../lib'; | |
10 | require './test.pl'; | |
11 | ||
12 | eval { require XS::APItest; XS::APItest->import('sv_count'); 1 } | |
13 | or skip_all("XS::APItest not available"); | |
14 | } | |
15 | ||
459defa1 | 16 | plan tests => 4; |
d97c33b5 DM |
17 | |
18 | # run some code N times. If the number of SVs at the end of loop N is | |
19 | # greater than (N-1)*delta at the end of loop 1, we've got a leak | |
20 | # | |
21 | sub leak { | |
22 | my ($n, $delta, $code, @rest) = @_; | |
23 | my $sv0 = 0; | |
24 | my $sv1 = 0; | |
25 | for my $i (1..$n) { | |
26 | &$code(); | |
27 | $sv1 = sv_count(); | |
28 | $sv0 = $sv1 if $i == 1; | |
29 | } | |
30 | cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest); | |
31 | } | |
32 | ||
33 | my @a; | |
34 | ||
35 | leak(5, 0, sub {}, "basic check 1 of leak test infrastructure"); | |
36 | leak(5, 0, sub {push @a,1;pop @a}, "basic check 2 of leak test infrastructure"); | |
37 | leak(5, 1, sub {push @a,1;}, "basic check 3 of leak test infrastructure"); | |
459defa1 DM |
38 | |
39 | sub TIEARRAY { bless [], $_[0] } | |
40 | sub FETCH { $_[0]->[$_[1]] } | |
41 | sub STORE { $_[0]->[$_[1]] = $_[2] } | |
42 | ||
43 | # local $tied_elem[..] leaks <20020502143736.N16831@dansat.data-plan.com>" | |
44 | { | |
45 | tie my @a, 'main'; | |
46 | leak(5, 0, sub {local $a[0]}, "local \$tied[0]"); | |
47 | } | |
48 |