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

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");
+}