t/op/local.t: tests for RT #7615

[perl5.git] / t / op / smartmatch.t

diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index f51884d..ca019fd 100644 (file)
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -76,7 +76,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore;
 my %fooormore = map { $_ => 0 } @fooormore;
 
 # Load and run the tests
-plan tests => 349+1;
+plan tests => 349+2;
 
 while (<DATA>) {
   SKIP: {
@@ -136,7 +136,6 @@ sub NOT_DEF() { undef }
 {
   # [perl #123860]
   # this can but might not crash
-  local $::TODO = "not yet fixed...";
   # This can but might not crash
   #
   # The second smartmatch would leave a &PL_sv_no on the stack for
@@ -151,6 +150,38 @@ sub NOT_DEF() { undef }
                 "don't fill the stack with rubbish");
 }
 
+{
+    # [perl #123860] continued;
+    # smartmatch was failing to SPAGAIN after pushing an SV and calling
+    # pp_match, which may have resulted in the stack being realloced
+    # in the meantime. Test this by filling the stack with pregressively
+    # larger amounts of data. At some point the stack will get realloced.
+    my @a = qw(x);
+    my %h = qw(x 1);
+    my @args;
+    my $x = 1;
+    my $bad = -1;
+    for (1..1000)  {
+        push @args, $_;
+        my $exp_n  = join '-',  (@args, $x == 0);
+        my $exp_y  = join '-',  (@args, $x == 1);
+
+        my $got_an = join '-',  (@args, (/X/ ~~ @a));
+        my $got_ay = join '-',  (@args, (/x/ ~~ @a));
+        my $got_hn = join '-',  (@args, (/X/ ~~ %h));
+        my $got_hy = join '-',  (@args, (/x/ ~~ %h));
+
+        if (   $exp_n ne $got_an || $exp_n ne $got_hn
+            || $exp_y ne $got_ay || $exp_y ne $got_hy
+        ) {
+            $bad = $_;
+            last;
+        }
+    }
+    is($bad, -1, "RT 123860: stack realloc");
+}
+
+
 # Prefix character :
 #   - expected to match
 # ! - expected to not match