diff options
| -rw-r--r-- | t/op/svleak.t | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/t/op/svleak.t b/t/op/svleak.t index 669b00e0a3..7b1f8f08c7 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -13,7 +13,7 @@ BEGIN { or skip_all("XS::APItest not available"); } -plan tests => 4; +plan tests => 5; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -30,6 +30,28 @@ sub leak { cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest); } +# run some expression N times. The expr is concatenated N times and then +# evaled, ensuring that that there are no scope exits between executions. +# If the number of SVs at the end of expr N is greater than (N-1)*delta at +# the end of expr 1, we've got a leak +# +sub leak_expr { + my ($n, $delta, $expr, @rest) = @_; + my $sv0 = 0; + my $sv1 = 0; + my $true = 1; # avoid stuff being optimised away + my $code1 = "($expr || \$true)"; + my $code = "$code1 && (\$sv0 = sv_count())" . ("&& $code1" x 4) + . " && (\$sv1 = sv_count())"; + if (eval $code) { + cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest); + } + else { + fail("eval @rest: $@"); + } +} + + my @a; leak(5, 0, sub {}, "basic check 1 of leak test infrastructure"); @@ -46,3 +68,9 @@ sub STORE { $_[0]->[$_[1]] = $_[2] } leak(5, 0, sub {local $a[0]}, "local \$tied[0]"); } +# [perl #74484] repeated tries leaked SVs on the tmps stack + +{ + local $TODO = 'not fixed yet'; + leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak"); +} |