Commit b46ff331ac for perl
commit b46ff331ac7c3932062d77bb6d0eb850f8eafc70
Author: Richard Leach <rich+perl@hyphen-dash-hyphen.info>
Date: Wed Oct 7 20:55:41 2026 +0000
Correctly skip when PLUS fails to match a UTF8 char
Previously, all characters with a matching first _byte_ were skipped,
instead of all matching _characters_ as intended.
This caused `"àéàj" =~ /à+j/` to fail to match in GH#24916.
The faulty code seems to date back to when the UTF-8 support was added.
(https://github.com/Perl/perl5/commit/a0ed51b)
The code path might not have always been reachable. The following changes
leading up to 5.18.0 seem to have inadvertently exposed the bug:
* 51e6836 - regcomp.c: Slightly relax restriction of SIMPLE nodes
* b40a2c1 - regex: Allow any single char to be SIMPLE
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index f96be57d24..2eaea9278f 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -432,6 +432,15 @@ accuracy may follow within this development cycle.
=item *
+A regular expression performing a greedy match of a UTF8 character may
+have incorrectly failed if the first attempt at a match was unsuccessful.
+Instead of skipping over all consecutive instances of that character,
+all consecutive characters that had the same first I<byte> were skipped.
+
+[GH #24916]
+
+=item *
+
XXX
=item *
diff --git a/regexec.c b/regexec.c
index 7a8bbae541..a8860d6ea8 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4096,8 +4096,6 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
/* we have /x+whatever/ */
- /* it must be a one character string (XXXX Except is_utf8_pat?) */
- char ch;
#ifdef DEBUGGING
int did_match = 0;
#endif
@@ -4105,14 +4103,26 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
if (! prog->anchored_utf8) {
to_utf8_substr(prog);
}
- ch = SvPVX_const(prog->anchored_utf8)[0];
+
+ const char * const ch = SvPVX_const(prog->anchored_utf8);
+ const STRLEN ch_bytes = UTF8SKIP(ch);
+ assert(ch_bytes <= (STRLEN)(strend - s));
+
REXEC_FBC_UTF8_SCAN(
- if (*s == ch) {
+ if (ch_bytes <= (STRLEN)(strend - s)
+ && *s == *ch /* Did the first byte match? */
+ && (ch_bytes == 1 /* and it's not a multi-byte char */
+ || memEQ(s, ch, ch_bytes) /* or else the whole char matches */
+ )
+ ) {
DEBUG_EXECUTE_r( did_match = 1 );
if (regtry(reginfo, &s)) goto got_it;
- s += UTF8_SAFE_SKIP(s, strend);
- while (s < strend && *s == ch)
- s += UTF8SKIP(s);
+ /* 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;
}
);
@@ -4123,7 +4133,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
}
}
- ch = SvPVX_const(prog->anchored_substr)[0];
+ const char ch = SvPVX_const(prog->anchored_substr)[0];
REXEC_FBC_NON_UTF8_SCAN(
if (*s == ch) {
DEBUG_EXECUTE_r( did_match = 1 );
diff --git a/t/re/re_tests b/t/re/re_tests
index fbd1476724..50aa20a4f3 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -2275,6 +2275,10 @@ z|(?:(?:a(*SKIP)b|ac)|a(*COMMIT)b)|x(*THEN)y|a aab n - - - extra sibling before
(?:(?:ab(?=c)c|ad(?=e)e)|af)|x(*THEN)y|a abc y $& abc - lookahead continuation in first trie word
(?:(?:ab(?=c)c|ad(?=e)e)|af)|x(*THEN)y|a ade y $& ade - lookahead continuation in second trie word
+# 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
+
# Keep these lines at the end of the file
# pat string y/n/etc expr expected-expr skip-reason comment
# vim: softtabstop=0 noexpandtab