In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/8bd05d90e59a554e79d73edf32bf35547dbc2c40?hp=f9bcfeacc119e37fd70816a2cb4678fded53e8d1>

- Log -----------------------------------------------------------------
commit 8bd05d90e59a554e79d73edf32bf35547dbc2c40
Author: David Mitchell <da...@iabyn.com>
Date:   Wed Apr 21 12:02:49 2010 +0100

    add TODO test for #74484 trie leak
    
    Also add leak_expr function to svleak.t to test an expression for leakage
    rather than a whole sub
-----------------------------------------------------------------------

Summary of changes:
 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 669b00e..7b1f8f0 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");
+}

--
Perl5 Master Repository

Reply via email to