Commit bb4e410fa2 for perl

commit bb4e410fa2a88da57fc68539f1dad46f495ee8d4
Author: David Mitchell <davem@iabyn.nospamdeletethisbit.com>
Date:   Sun Sep 20 14:09:17 2026 +0100

    regex: super-linear cache; shorter countdown

    The countdown initiated by each WHILEM node is a guess of when the match
    will start to go super-linear. It is currently set to to the length of
    the string.

    This commit changes the countdown to instead be equal to the length of
    the *remaining* string. This may make the cache kick in sooner when the
    string is long but the super-linear backtracking behaviour is only
    happening towards the end of the string. See the code in the added
    benchmark entry for an example.

    This if of course just a heuristic. This commit will cause some patterns
    to allocate a cache where before they didn't, while making other
    patterns needlessly backtrack less. But now that a 1/Nth size cache is
    allocated per WHILEM node rather than a single monolithic cache per
    regex run, getting this guess wrong is less harmful.

    Note that this doesn't affect the size of the cache: that still gets
    allocated a bit per string byte, because a later iteration of a WHILEM
    node might be at an earlier string position.

    A test in t/re/pat_rt_report.t is annoyingly sensitive to the number
    of backtracking iterations. My final fix for this test is to ignore how
    many iterations it does, but instead make sure that for any iterations
    it *does* do, @- always has two elements. (In the original bug report,
    it sometimes had a spurious undef third element.)

diff --git a/pod/perlreguts.pod b/pod/perlreguts.pod
index 1e584d35e0..1b25df91ca 100644
--- a/pod/perlreguts.pod
+++ b/pod/perlreguts.pod
@@ -1226,9 +1226,11 @@ pattern like C</(...)*(...)*/> which has two quantifiers, two
 To avoid a potentially large malloc() for every match that has been marked
 as suitable for a SLC, a per-node countdown is initiated the first time a
 candidate C<WHILEM> node is reached; only when the number of iterations of
-that particular node is equal to the string length is a cache for that
-node actually allocated and initialised. This crude heuristic is an
-indication that the match has gone super-linear.
+that particular node is equal to the remaining string length is a cache
+for that node actually allocated and initialised. This crude heuristic is
+an indication that the match has gone super-linear. Guess wrong and a
+cache will be unnecessarily allocated or, conversely, unnecessary
+backtracking will happen.

 =item *

diff --git a/regexec.c b/regexec.c
index e094c47be5..bbaedfe511 100644
--- a/regexec.c
+++ b/regexec.c
@@ -9235,7 +9235,7 @@ NULL
                      * linear. Note that a degenerate zero-length
                      * string will have the effect of not starting a
                      * countdown */
-                    STRLEN count = reginfo->strend - reginfo->strbeg;
+                    STRLEN count = reginfo->strend - locinput;

                     if (PL_re_superlinear_cache_delay) {
                         /* Apply countdown modifier */
diff --git a/t/perf/benchmarks b/t/perf/benchmarks
index b5249ff3f0..e39d344324 100644
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -2714,5 +2714,12 @@
         code    => '/^(a|xy)+;(bb?)*bbbbbbbbbb;(c|xy)+$/',
     },

+    'regex::slc::long_lead' => {
+        desc    => 'slc: iterating only near end of string',
+        setup   => '$_ = ("a" x 1000) . "a;bbbbbbbbbbbbbbbbbbbb";
+                    ${^RE_SUPERLINEAR_CACHE_DELAY}=-200_000',
+        code    => '/^a+;(bb?)*bbbbbbbbbb$/',
+    },
+
     # XXX millions more general regex tests needed here
 ];
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 9d8be19a6b..701cf9dbfb 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -767,14 +767,12 @@ sub run_tests {
         is($ok,3, "Optimistic eval does not disable optimisations");
     }

-    SKIP: {
-        skip("test sensitive to SLC iterations", 1)
-            if ${^RE_SUPERLINEAR_CACHE_DELAY};
+    {
         my $message = '@-/@+ should not have undefined values; Bug 22614';
         local $_ = 'ab';
         our @len = ();
         /(.){1,}(?{push @len,0+@-})(.){1,}(?{})^/;
-        is("@len", "2 2 2", $message);
+        is(grep($_ != 2, @len), 0, $message);
     }

     {