Commit 6c8b86a996 for perl

commit 6c8b86a99632f38f72a85c303480aa3f3312711c
Author: Richard Leach <rich+perl@hyphen-dash-hyphen.info>
Date:   Thu Oct 8 18:48:17 2026 +0000

    PLUS should not skip characters if a (*SKIP) already did so

    When a regex match attempt:
    * starts on an anchored substring with a single character `PLUS` regnode
    * and the attempted match is unsuccessful

    all consecutive instances of that character are then skipped over as
    they cannot start a successful match either.

    That is fine, as long as the failed pattern did not encounter a
    `(*SKIP)` and has already moved past those consecutive characters.
    This commit adds a check to see if that has transpired. Previously,
    characters that should have formed part of the _next_ attempted match
    could have been erroneously skipped. (A "double-skip" in effect.)

    This commit adds some new tests to _re_tests_ and also gives the two
    preceding tests some descriptions.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e51767a1d2..7d3d7a4baf 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -456,6 +456,12 @@ performed a I<non-greedy> match because of skipped flag clearance.

 =item *

+An anchored regular expressions starting with a repeating character could
+have incorrectly skipped later instances of that character if the match
+contained a C<(*SKIP)> and was initially unsuccessful.
+
+=item *
+
 In some cases warnings that occurred while using unpack on an invalid
 UTF-8 marked string would result in an invalid free.  [GH #24913]

diff --git a/regexec.c b/regexec.c
index a3ec5c6ac8..ffc6563bf0 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4210,12 +4210,15 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
                 ) {
                     DEBUG_EXECUTE_r( did_match = 1 );
                     if (regtry(reginfo, &s)) goto got_it;
-                    /* No match at this x, skip this run of x's */
-                    s += ch_bytes;
-                    while (ch_bytes <= (STRLEN)(strend - s)
-                           && *s == *ch
-                           && memEQ(s + 1, ch + 1, ch_bytes - 1))
+                    /* regtry might have hit a (*SKIP) */
+                    if (! LAST_REGTRY_SKIPPED_FORWARD(reginfo)) {
+                        /* No match at this x, skip this run of x's */
                         s += ch_bytes;
+                        while (ch_bytes <= (STRLEN)(strend - s)
+                               && *s == *ch
+                               && memEQ(s + 1, ch + 1, ch_bytes - 1))
+                            s += ch_bytes;
+                    }
                 }
             );

@@ -4231,9 +4234,12 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
                 if (*s == ch) {
                     DEBUG_EXECUTE_r( did_match = 1 );
                     if (regtry(reginfo, &s)) goto got_it;
-                    s++;
-                    while (s < strend && *s == ch)
+                    /* regtry might have hit a (*SKIP) */
+                    if (! LAST_REGTRY_SKIPPED_FORWARD(reginfo)) {
                         s++;
+                        while (s < strend && *s == ch)
+                            s++;
+                    }
                 }
             );
         }
diff --git a/t/re/re_tests b/t/re/re_tests
index 1f3cc29d82..a23ae33cae 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -2278,9 +2278,16 @@ z|(?:(?:a(*SKIP)b|ac)|a(*COMMIT)b)|x(*THEN)y|a	aab	n	-	-	-	extra sibling before
 # GH #24915
 x+(?:b{2}){2}	xxbbbb	y	$&	xxbbbb	-	quantified sub-pattern after PLUS

-# GH24916
-\x{e0}+j	\x{e0}\x{e9}\x{e0}j	y	$&	\x{e0}j
-\x{e0}+j	\x{e0}\x{e9}\x{e0}\x{e0}j	y	$&	\x{e0}\x{e0}j
+# GH #24916
+\x{e0}+j	\x{e0}\x{e9}\x{e0}j	y	$&	\x{e0}j	-	PLUS skip on char match, not first byte match #1
+\x{e0}+j	\x{e0}\x{e9}\x{e0}\x{e0}j	y	$&	\x{e0}\x{e0}j	-	PLUS skip on char match, not first byte match #2
+# GH #24916 follow-on
+(a+X(*SKIP)j)	aXaXj	y	$1	aXj	-	PLUS skip after (*SKIP) [ASCII]
+(\x{100}+X(*SKIP)j)	\x{100}X\x{100}Xj	y	$1	\x{100}Xj	-	PLUS skip after (*SKIP) [UTF8]
+(a+X(*MARK:m)(*SKIP:m)j)	aXaXj	y	$1	aXj	-	PLUS skip after (*SKIP:NAME) [ASCII]
+(\x{100}+X(*MARK:m)(*SKIP:m)j)	\x{100}X\x{100}Xj	y	$1	\x{100}Xj	-	PLUS skip after (*SKIP:NAME) [UTF8]
+a+X(*COMMIT)j	aXaXj	n	-	-	-	PLUS skip after (*COMMIT) [ASCII]
+\x{100}+X(*COMMIT)j	\x{100}X\x{100}Xj	n	-	-	-	PLUS skip after (*COMMIT) [UTF8]

 # GH #24926
 (?:x??\x{100})*a+	aaaa	y	$&	aaaa	-	minmod cleared by CURLY