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 | ||
8bd05d90 | 16 | plan tests => 5; |
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 | ||
8bd05d90 DM |
33 | # run some expression N times. The expr is concatenated N times and then |
34 | # evaled, ensuring that that there are no scope exits between executions. | |
35 | # If the number of SVs at the end of expr N is greater than (N-1)*delta at | |
36 | # the end of expr 1, we've got a leak | |
37 | # | |
38 | sub leak_expr { | |
39 | my ($n, $delta, $expr, @rest) = @_; | |
40 | my $sv0 = 0; | |
41 | my $sv1 = 0; | |
42 | my $true = 1; # avoid stuff being optimised away | |
43 | my $code1 = "($expr || \$true)"; | |
44 | my $code = "$code1 && (\$sv0 = sv_count())" . ("&& $code1" x 4) | |
45 | . " && (\$sv1 = sv_count())"; | |
46 | if (eval $code) { | |
47 | cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest); | |
48 | } | |
49 | else { | |
50 | fail("eval @rest: $@"); | |
51 | } | |
52 | } | |
53 | ||
54 | ||
d97c33b5 DM |
55 | my @a; |
56 | ||
57 | leak(5, 0, sub {}, "basic check 1 of leak test infrastructure"); | |
58 | leak(5, 0, sub {push @a,1;pop @a}, "basic check 2 of leak test infrastructure"); | |
59 | leak(5, 1, sub {push @a,1;}, "basic check 3 of leak test infrastructure"); | |
459defa1 DM |
60 | |
61 | sub TIEARRAY { bless [], $_[0] } | |
62 | sub FETCH { $_[0]->[$_[1]] } | |
63 | sub STORE { $_[0]->[$_[1]] = $_[2] } | |
64 | ||
65 | # local $tied_elem[..] leaks <20020502143736.N16831@dansat.data-plan.com>" | |
66 | { | |
67 | tie my @a, 'main'; | |
68 | leak(5, 0, sub {local $a[0]}, "local \$tied[0]"); | |
69 | } | |
70 | ||
8bd05d90 DM |
71 | # [perl #74484] repeated tries leaked SVs on the tmps stack |
72 | ||
2e64971a | 73 | leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak"); |