Commit 1c1b22539e for perl
commit 1c1b22539ea7c251d3fafc01a8b682c8b10fefac
Author: Yves Orton <demerphq@gmail.com>
Date: Sat Oct 10 19:43:41 2026 +0200
regex: accelerate Aho-Corasick scans with octet prefilters
We can skip much of the input before trying the Aho-Corasick matcher.
Build separate Boyer-Moore-Horspool shift tables for native and UTF-8
targets, and a bitmap of the octets which can start a word. The shift
tables let us skip ahead, and the bitmap rejects impossible starts.
When a whole UV contains no possible start, we can skip identical UVs as
well. This handles long runs of repeated characters without checking
each octet. We only do this at the root, where no word is in progress.
Avoid updating the position ring on failed root transitions, and reject
native targets outright when every word needs a codepoint above 255.
Partial fix for https://github.com/Perl/perl5/issues/24934
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 75dc8cb4a0..d2f932b013 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -95,6 +95,14 @@ Unicode case folding can join neighboring folded literals after the
optimizer records their fixed substrings.
L<[GH #19953]|https://github.com/Perl/perl5/issues/19953>
+=item *
+
+The Aho-Corasick regex scanner uses Boyer-Moore-Horspool shift tables to skip
+positions where no literal alternative can start. It can also skip repeated
+blocks of octets that cannot start an alternative. These filters apply to
+eligible case-sensitive literals, with separate shift tables for Latin-1 and
+UTF-8 targets.
+
=back
=head1 Modules and Pragmata
diff --git a/regcomp.c b/regcomp.c
index 7cf52ff9f9..cb03736813 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -13982,6 +13982,9 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx)
if ( !refcount ) {
PerlMemShared_free(aho->states);
PerlMemShared_free(aho->fail);
+ /* if we have a bmh/start-char-map then release it */
+ if (aho->prefilter)
+ PerlMemShared_free(aho->prefilter);
/* do this last!!!! */
PerlMemShared_free(ri->data->data[n]);
/* we should only ever get called once, so
diff --git a/regcomp.h b/regcomp.h
index 6e7c648d2c..c5422d17d9 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -1342,6 +1342,7 @@ enum trie_flags {
TRIE_CP_WIDE = TRIE_CP_AWKWARD | TRIE_CP_HIGH,
TRIE_FOLD_NATIVE = 8,
TRIE_FOLD_UNICODE = 16,
+ TRIE_CP_NO_LATIN1_WORDS = 32, /* every trie word has a codepoint > 255 */
TRIE_FOLD_MASK = TRIE_FOLD_NATIVE | TRIE_FOLD_UNICODE
};
@@ -1404,6 +1405,16 @@ struct reg_trie_data_ {
typedef struct reg_trie_data_ reg_trie_data;
+/* Full filter allocation: one BMH table for each target encoding, then the
+ * encoding-masked start map. */
+#define REG_AC_PREFILTER_LATIN1_BMH_OFFSET 0
+#define REG_AC_PREFILTER_UTF8_BMH_OFFSET 256
+#define REG_AC_PREFILTER_MAP_OFFSET 512
+#define REG_AC_PREFILTER_MAP_SIZE 256
+#define REG_AC_PREFILTER_SIZE (512 + REG_AC_PREFILTER_MAP_SIZE)
+#define REG_AC_PREFILTER_LATIN1_MASK 0x01
+#define REG_AC_PREFILTER_UTF8_MASK 0x02
+
/* refcount is first in both this and reg_trie_data_ to allow a space
optimisation in Perl_regdupe. */
struct reg_ac_data_ {
@@ -1411,6 +1422,16 @@ struct reg_ac_data_ {
U32 trie;
U32 *fail;
reg_trie_state *states;
+ /* The allocation contains the Latin-1 BMH table at offset 0, the UTF-8
+ * BMH table at 256, and the start map at 512. Map entries use mask 0x01
+ * for Latin-1 starts and 0x02 for UTF-8 starts. Each minlen is the
+ * shortest eligible literal length in that encoding's octets, capped
+ * at 255. Zero means that encoding has no usable BMH table.
+ * The allocation is immutable and
+ * shared by regex clones through this AC structure's refcount. */
+ U8 *prefilter;
+ U8 latin1_minlen;
+ U8 utf8_minlen;
};
typedef struct reg_ac_data_ reg_ac_data;
diff --git a/regcomp_trie.c b/regcomp_trie.c
index 6be0dd14af..afa117ee5e 100644
--- a/regcomp_trie.c
+++ b/regcomp_trie.c
@@ -568,6 +568,7 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
STRLEN len = 0;
UV uvc = 0;
U32 curword = 0;
+ U32 latin1_word_count = 0;
U32 next_alloc = 0;
U32 state_capacity = 0;
regnode *jumper = NULL;
@@ -722,6 +723,7 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
U32 state = 1; /* required init */
U32 wordlen = 0; /* required init */
int foldlen = 0;
+ bool word_is_latin1 = TRUE;
STRLEN minchars = 0;
STRLEN maxchars = 0;
lastbranch = cur;
@@ -767,6 +769,7 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
else if (UTF8_IS_ABOVE_LATIN1(*uc)) {
trie->prop_flags |= TRIE_CP_HIGH;
trie_needs_codepoint_processing = true;
+ word_is_latin1 = FALSE;
}
else {
trie->prop_flags |= TRIE_CP_AWKWARD;
@@ -814,6 +817,7 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
else {
trie->prop_flags |= TRIE_CP_HIGH;
trie_needs_codepoint_processing = true;
+ word_is_latin1 = FALSE;
}
/* The trie contains every character in the folded
@@ -913,6 +917,8 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
curword++;
assert(curword <= word_count);
+ if (word_is_latin1)
+ latin1_word_count++;
trie->wordinfo[curword].prev = 0;
trie->wordinfo[curword].len = wordlen;
trie->wordinfo[curword].accept = state;
@@ -969,6 +975,12 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
} /* end list construction */
+ /* If every stored literal needs a codepoint unavailable in a
+ * non-UTF-8 target, the AC node cannot match that target at all. */
+ if ((flags == EXACT || flags == EXACT_REQ8)
+ && curword == word_count && !latin1_word_count)
+ trie->prop_flags |= TRIE_CP_NO_LATIN1_WORDS;
+
/* The list pass has also completed the source analysis. */
trie->before_paren = OP(first) == BRANCH
? ARG1a(first)
@@ -1727,6 +1739,82 @@ Perl_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
: MADE_TRIE;
}
+/* Convert one trie path to the octets seen in a Latin-1 target. A path with
+ * one octet per source character contains only UTF-8 invariant characters,
+ * so its octets already have the target representation. Longer paths are
+ * UTF-8 encodings and can be downgraded only when every character fits in
+ * Latin-1. The caller excludes case-folded tries. */
+static bool
+S_ac_path_as_latin1(const U8 *path, const U32 path_len, const U32 source_chars,
+ U8 *latin1_path, U32 *latin1_len)
+{
+ if (path_len == source_chars) {
+ Copy(path, latin1_path, path_len, U8);
+ *latin1_len = path_len;
+ return TRUE;
+ }
+
+ if (path_len < source_chars)
+ return FALSE;
+
+ U32 pos = 0;
+ U32 out = 0;
+
+ while (pos < path_len) {
+ STRLEN char_len = 0;
+ const UV cp = valid_utf8_to_uv(path + pos, &char_len);
+
+ if (cp > 255 || !char_len || char_len > path_len - pos)
+ return FALSE;
+ latin1_path[out++] = (U8)cp;
+ pos += (U32)char_len;
+ }
+
+ if (out != source_chars)
+ return FALSE;
+ *latin1_len = out;
+
+ return TRUE;
+}
+
+#ifdef DEBUGGING
+static void
+S_dump_ac_prefilter_table(pTHX_ const char *name, const U8 *table,
+ const U32 length, const U32 depth)
+{
+ U32 c;
+
+ re_indentf("%s\n", depth, name);
+ for (c = 0; c < length; c++) {
+ if (!(c % 16))
+ re_indentf("%02" UVXf ":", depth + 1, (UV)c);
+ re_printf(" %02" UVXf, (UV)table[c]);
+ if (c % 16 == 15)
+ re_printf("\n");
+ }
+}
+
+static void
+S_dump_ac_prefilters(pTHX_ const reg_ac_data *aho, const U32 depth)
+{
+ re_indentf("AC prefilters: Latin-1 m=%u, UTF-8 m=%u\n",
+ depth, (unsigned)aho->latin1_minlen,
+ (unsigned)aho->utf8_minlen);
+ if (!aho->prefilter)
+ return;
+
+ S_dump_ac_prefilter_table(aTHX_ " start-octet map (0x01=Latin-1, 0x02=UTF-8):",
+ aho->prefilter + REG_AC_PREFILTER_MAP_OFFSET,
+ REG_AC_PREFILTER_MAP_SIZE, depth);
+ S_dump_ac_prefilter_table(aTHX_ " Latin-1 BMH shifts:",
+ aho->prefilter + REG_AC_PREFILTER_LATIN1_BMH_OFFSET,
+ TRIE_ALPHABET_SIZE, depth);
+ S_dump_ac_prefilter_table(aTHX_ " UTF-8 BMH shifts:",
+ aho->prefilter + REG_AC_PREFILTER_UTF8_BMH_OFFSET,
+ TRIE_ALPHABET_SIZE, depth);
+}
+#endif
+
regnode *
Perl_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *source, U32 depth)
{
@@ -1789,15 +1877,174 @@ Perl_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *s
SHORT_TRIE_DATA_SLOT_set(stclass, data_slot);
aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
RExC_rxi->data->data[ data_slot ] = (void*)aho;
+ aho->refcount = 1;
aho->trie = trie_offset;
aho->states = (reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
Copy( trie->states, aho->states, numstates, reg_trie_state );
+
+ /* Only unprefixed tries can be the first regex node and use this AC
+ * start class. The constructor runs after prefix extraction. An
+ * accepting root represents an empty alternative, which must be checked
+ * at the current position before any prefilter can skip ahead. */
+ if (FLAGS(source) == EXACT && trie->startstate == 1
+ && !trie->states[1].wordnum
+ && !trie->prefixlen_octets && !trie->prefixlen_chars
+ && !(trie->prop_flags & TRIE_FOLD_MASK)
+ && trie->minlen)
+ {
+ U32 *parents;
+ U32 *path_depths;
+ U8 *parent_octets;
+ U8 *path;
+ U8 *latin1_path;
+ U8 *start_map;
+ U8 *latin1_shift;
+ U8 *utf8_shift;
+ U32 max_path_len = 0;
+ U32 utf8_words = 0;
+ U32 latin1_minlen = 0;
+ U32 utf8_minlen = 255;
+
+ /* Recover each literal's path through the post-prefix trie. This
+ * lets the two tables describe the octets actually scanned for each
+ * target encoding, including Latin-1 representations of UTF-8
+ * literals. */
+ Newxz(parents, numstates, U32);
+ Newxz(path_depths, numstates, U32);
+ Newxz(parent_octets, numstates, U8);
+
+ /* List construction gives each child a later state number than
+ * its parent, so the parent depth is known when we visit a child. */
+ for (U32 state = 1; state < numstates; state++) {
+ const U32 trans_base = trie->states[state].trans.base;
+ for (U32 ch = trie->states[state].min_octet;
+ trans_base && ch <= trie->states[state].max_octet; ch++)
+ {
+ const U32 next = S_trie_trans_state(trie, state, trans_base,
+ ch, 0);
+ if (next) {
+ assert(next > state);
+ parents[next] = state;
+ parent_octets[next] = (U8)ch;
+ path_depths[next] = path_depths[state] + 1;
+ if (path_depths[next] > max_path_len)
+ max_path_len = path_depths[next];
+ }
+ }
+ }
+
+ Newx(path, max_path_len ? max_path_len : 1, U8);
+ Newx(latin1_path, trie->maxlen ? trie->maxlen : 1, U8);
+
+ /* Build the BMH tables and start map from the trie after prefix
+ * extraction. The scanner uses BMH to find candidates and the map
+ * to reject candidates whose first octet cannot start a literal. */
+ aho->prefilter = (U8 *)PerlMemShared_calloc(
+ REG_AC_PREFILTER_SIZE, sizeof(U8));
+ start_map = aho->prefilter + REG_AC_PREFILTER_MAP_OFFSET;
+ latin1_shift = aho->prefilter + REG_AC_PREFILTER_LATIN1_BMH_OFFSET;
+ utf8_shift = aho->prefilter + REG_AC_PREFILTER_UTF8_BMH_OFFSET;
+
+ /* First pass: find the anchor lengths and both possible start sets. */
+ for (U32 state = 2; state < numstates; state++) {
+ const U32 word = trie->states[state].wordnum;
+ U32 path_len;
+ U32 cursor;
+ U32 i;
+
+ if (!word)
+ continue;
+
+ path_len = path_depths[state];
+ cursor = state;
+ for (i = path_len; i; i--) {
+ path[i - 1] = parent_octets[cursor];
+ cursor = parents[cursor];
+ }
+
+ utf8_words++;
+ if (path_len < utf8_minlen)
+ utf8_minlen = path_len;
+ if (path_len)
+ start_map[path[0]] |= REG_AC_PREFILTER_UTF8_MASK;
+
+ {
+ U32 latin1_len = 0;
+ if (S_ac_path_as_latin1(path, path_len,
+ trie->wordinfo[word].len,
+ latin1_path, &latin1_len))
+ {
+ if (!latin1_minlen || latin1_len < latin1_minlen)
+ latin1_minlen = latin1_len;
+ if (latin1_len)
+ start_map[latin1_path[0]] |= REG_AC_PREFILTER_LATIN1_MASK;
+ }
+ }
+ }
+
+ if (latin1_minlen > 255)
+ latin1_minlen = 255;
+ if (!utf8_words)
+ utf8_minlen = 0;
+ aho->latin1_minlen = (U8)latin1_minlen;
+ aho->utf8_minlen = (U8)utf8_minlen;
+ if (utf8_minlen)
+ memset(utf8_shift, (int)utf8_minlen, TRIE_ALPHABET_SIZE);
+ if (latin1_minlen)
+ memset(latin1_shift, (int)latin1_minlen, TRIE_ALPHABET_SIZE);
+
+ /* Second pass: fill the BMH shifts from each target's effective
+ * literal representation. */
+ for (U32 state = 2; state < numstates; state++) {
+ const U32 word = trie->states[state].wordnum;
+ U32 path_len;
+ U32 cursor;
+ U32 i;
+
+ if (!word)
+ continue;
+
+ path_len = path_depths[state];
+ cursor = state;
+ for (i = path_len; i; i--) {
+ path[i - 1] = parent_octets[cursor];
+ cursor = parents[cursor];
+ }
+
+ for (i = 0; i < utf8_minlen; i++) {
+ const U8 distance = (U8)(utf8_minlen - 1 - i);
+ if (distance < utf8_shift[path[i]])
+ utf8_shift[path[i]] = distance;
+ }
+
+ if (latin1_minlen) {
+ U32 latin1_len = 0;
+ if (S_ac_path_as_latin1(path, path_len,
+ trie->wordinfo[word].len,
+ latin1_path, &latin1_len))
+ {
+ for (i = 0; i < latin1_minlen; i++) {
+ const U8 distance = (U8)(latin1_minlen - 1 - i);
+ if (distance < latin1_shift[latin1_path[i]])
+ latin1_shift[latin1_path[i]] = distance;
+ }
+ }
+ }
+ }
+
+ DEBUG_TRIE_COMPILE_r(S_dump_ac_prefilters(aTHX_ aho, depth));
+
+ Safefree(latin1_path);
+ Safefree(path);
+ Safefree(parent_octets);
+ Safefree(path_depths);
+ Safefree(parents);
+ }
/* The breadth-first work queue can contain each state at most once, so
* numstates entries suffice. q_read and q_write address it as a
* circular queue while q_write advances monotonically. */
Newx( q, numstates, U32);
aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
- aho->refcount = 1;
fail = aho->fail;
/* initialize fail[0..1] to be 1 so that we always have
a valid final fail state */
diff --git a/regexec.c b/regexec.c
index e40fb59362..65ab1d4624 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2386,6 +2386,64 @@ S_get_break_val_cp_checked(SV* const invlist, const UV cp_in)
#define getWB_VAL_UTF8(pos, strend) \
generic_GET_BREAK_VAL_UTF8_(getWB_VAL_CP, pos, strend)
+/* After checking a full UV-sized window of rejected starts, use that window
+ * as a seek word. Identical following words can be skipped without checking
+ * their starts again. */
+static const U8 *
+S_scan_repeated_uv_blocks(const U8 *p, const U8 *end, const U8 *last_start,
+ const U8 *start_map, const U8 start_mask,
+ const bool utf8_target)
+{
+ const STRLEN block_size = sizeof(UV);
+ const U8 * const start_limit = last_start + 1;
+ const U8 * const scan_start = p;
+ UV pattern;
+ UV value;
+
+ /* The caller has already rejected p. Keep checking starts until p is
+ * aligned and a complete checked window lies behind it. */
+ p++;
+ while (p < start_limit) {
+ if ((STRLEN)(p - scan_start) >= block_size
+ && PTR2UV(p) % block_size == 0)
+ {
+ break;
+ }
+ if ((!utf8_target || !UTF8_IS_CONTINUATION(*p))
+ && (start_map[*p] & start_mask))
+ {
+ return p;
+ }
+ p++;
+ }
+
+ if (p >= start_limit)
+ return p;
+
+ /* The preceding window has been checked, so an equal word is safe to
+ * skip. A differing word is left for the normal scanner. */
+ if ((STRLEN)(end - p) < block_size)
+ return p;
+
+ /* These fixed-size copies should compile to the same word loads as
+ * dereferencing aligned UV pointers. Copy avoids C aliasing issues
+ * when reading the octet buffer as a UV. */
+ Copy(p - block_size, &pattern, block_size, U8);
+ Copy(p, &value, block_size, U8);
+ if (pattern != value)
+ return p;
+
+ p += block_size;
+ while (p < start_limit && (STRLEN)(end - p) >= block_size) {
+ memcpy(&value, p, block_size);
+ if (value != pattern)
+ return p;
+ p += block_size;
+ }
+
+ return p;
+}
+
/* We know what class REx starts with. Try to find this position... */
/* if reginfo->intuit, its a dryrun */
/* annoyingly all the vars in this routine have different names from their counterparts
@@ -3386,12 +3444,41 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
/* what trie are we using right now */
reg_ac_data *aho = (reg_ac_data*)progi->data->data[ TRIE_DATA_SLOT(c) ];
reg_trie_data *trie = (reg_trie_data*)progi->data->data[aho->trie];
+ const U8 * const prefilter = aho->prefilter;
+ const U8 *start_map = prefilter
+ ? prefilter + REG_AC_PREFILTER_MAP_OFFSET : NULL;
+ const U8 *bmh_shift = prefilter
+ ? prefilter + (utf8_target
+ ? REG_AC_PREFILTER_UTF8_BMH_OFFSET
+ : REG_AC_PREFILTER_LATIN1_BMH_OFFSET) : NULL;
+ const U8 bmh_minlen = utf8_target ? aho->utf8_minlen
+ : aho->latin1_minlen;
+ const U8 start_mask = utf8_target ? REG_AC_PREFILTER_UTF8_MASK
+ : REG_AC_PREFILTER_LATIN1_MASK;
+ const bool has_bmh = prefilter && bmh_minlen;
+
+ /* Every literal path requires a codepoint above Latin-1, so
+ * an unflagged target cannot match this start-of-program trie. */
+ if (!utf8_target && FLAGS(c) == EXACT
+ && trie->startstate == 1
+ && !trie->states[1].wordnum
+ && !trie->prefixlen_octets && !trie->prefixlen_chars
+ && (trie->prop_flags & TRIE_CP_NO_LATIN1_WORDS))
+ {
+ break;
+ }
+ /* trie->minlen counts characters. Subtracting that many octets
+ * gives a conservative start limit for UTF-8. The BMH loop
+ * checks its encoding's octet length before reading an anchor. */
const char *last_start = strend - trie->minlen;
#ifdef DEBUGGING
const char *real_start = s;
#endif
STRLEN maxlen = trie->maxlen;
+#ifndef DEBUGGING
+ const U32 root_base = aho->states[1].trans.base;
+#endif
U8 **points; /* map of where we were in the input string
when reading a given char. For ASCII this
is unnecessary overhead as the relationship
@@ -3428,8 +3515,6 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
points = points_heap;
}
- /* Trie start-byte filtering is temporarily disabled while the
- * post-prefix-extraction start state is being validated. */
/* this is the Aho-Corasick algorithm modified a touch
to include special handling for long "unknown char" sequences.
The basic idea being that we use AC as long as we are dealing
@@ -3464,14 +3549,73 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
while (state && (foldlen || octets_remaining
|| uc < (U8*)strend)) {
bool failed = false;
+ bool transitioned_from_root = false;
U32 word = aho->states[ state ].wordnum;
+ U8 *point;
+ bool point_may_be_start;
if( state == 1 ) {
if (uc >(U8*)last_start) break;
+
+ /* A prefilter may skip only from the AC root. Once
+ * AC has consumed a prefix, its failure state must
+ * retain that partial-match information. */
+ if (has_bmh && !foldlen && !octets_remaining) {
+ /* BMH positions its anchor by encoded octet
+ * length, but candidate starts must be character
+ * boundaries in UTF-8 targets. */
+ while (uc <= (U8*)last_start) {
+ U8 distance;
+
+ if (utf8_target && UTF8_IS_CONTINUATION(*uc)) {
+ uc++;
+ pointpos = 0;
+ continue;
+ }
+ if ((STRLEN)((U8*)strend - uc) < bmh_minlen)
+ break;
+ distance = bmh_shift[uc[bmh_minlen - 1]];
+
+ /* For shifts zero and one, a start-map miss
+ * proves independently that no literal starts
+ * here. The helper checks each later start
+ * until it has a full rejected word. Equal
+ * following words repeat those rejected
+ * octets, so they cannot contain a start.
+ * UTF-8 continuation octets cannot be starts
+ * either. This proof does not depend on the
+ * BMH shift. We use it for small shifts to
+ * avoid walking repeated input one octet at
+ * a time. */
+ if (distance <= 1
+ && !(start_map[*uc] & start_mask))
+ {
+ /* The helper consumes at least the
+ * rejected octet at uc. */
+ uc = (U8 *)S_scan_repeated_uv_blocks(
+ uc, (U8*)strend, (U8*)last_start,
+ start_map, start_mask, utf8_target);
+ pointpos = 0;
+ continue;
+ }
+ if (!distance)
+ break;
+ uc += distance;
+ pointpos = 0;
+ }
+ if (uc > (U8*)last_start)
+ break;
+ }
}
+ /* The prefilter may have moved uc to a later candidate.
+ * Record that position if the root transition succeeds. */
+ point = uc;
+ point_may_be_start = !octets_remaining
+ && (!utf8_target || !UTF8_IS_CONTINUATION(*uc));
+
if ( word ) {
- U8 *lpos= points[ (pointpos - trie->wordinfo[word].len)
+ U8 *lpos = points[ (pointpos - trie->wordinfo[word].len)
% maxlen ];
if (!leftmost || lpos < leftmost) {
DEBUG_r(accepted_word = word);
@@ -3480,27 +3624,43 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
if (base == 0) break;
}
- if (!octets_remaining \
- && (!utf8_target || !UTF8_IS_CONTINUATION(*uc)))
- points[pointpos++ % maxlen]= uc;
REXEC_TRIE_READ_CHAR(trie_type, trie, uc,
(U8 *) strend, uscan, len, uvc,
octet, foldlen, foldbuf,
uniflags, octet_scan,
octets_remaining, octet_buffer);
+
DEBUG_TRIE_EXECUTE_r({
dump_exec_pos( (char *)uc, c, strend,
real_start, s, utf8_target, 0);
re_printf(
"%sAHOC: Octet:0x%-2" UVXf " CP:0x%-4" UVXf " ",
- PL_colors[4], (UV)octet, uvc);
+ PL_colors[4], (UV)octet, (UV)uvc);
if (isPRINT_A(uvc))
re_printf("'%c' ", (int)uvc );
else
- re_printf(" " ); /* four spaces to match "'x' " */
+ re_printf(" " );
});
-
+#ifndef DEBUGGING
+ if (state == 1) {
+ /* Root misses are the common case for sparse tries.
+ * They have no failure link to follow. */
+ if (root_base
+ && trie->trans[root_base + octet].check == 1)
+ {
+ transitioned_from_root = true;
+ state = trie->trans[root_base + octet].next;
+ }
+ else {
+ uc += len;
+ if (leftmost)
+ break;
+ continue;
+ }
+ }
+ else
+#endif
do {
#ifdef DEBUGGING
word = aho->states[ state ].wordnum;
@@ -3521,6 +3681,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
const U32 offset = base + octet;
if (trie->trans[offset].check == state)
{
+ if (state == 1)
+ transitioned_from_root = true;
failed = false;
state = trie->trans[offset].next;
DEBUG_TRIE_EXECUTE_r(
@@ -3544,6 +3706,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
break;
}
} while(state);
+ /* A root miss is not part of an active candidate, so it
+ * must not enter the point ring. A successful root
+ * transition starts a fresh candidate history; successful
+ * transitions from other states extend that history. */
+ if (!failed && state && point_may_be_start) {
+ if (transitioned_from_root)
+ pointpos = 0;
+ points[pointpos++ % maxlen] = point;
+ }
uc += len;
if (failed) {
if (leftmost)
@@ -7101,6 +7272,16 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
/* what trie are we using right now */
reg_trie_data * const trie
= (reg_trie_data*)rexi->data->data[ TRIE_DATA_SLOT(scan) ];
+
+ /* These literal paths all require codepoints that cannot
+ * occur in a non-UTF-8 target. */
+ if (!utf8_target
+ && (FLAGS(scan) == EXACT || FLAGS(scan) == EXACT_REQ8)
+ && (trie->prop_flags & TRIE_CP_NO_LATIN1_WORDS))
+ {
+ sayNO;
+ }
+
ST.before_paren = trie->before_paren;
ST.after_paren = trie->after_paren;
assert(ST.before_paren <= rex->nparens);
diff --git a/t/re/pat.t b/t/re/pat.t
index dd77e7b8d9..11146e1206 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -28,7 +28,7 @@ skip_all_without_unicode_tables();
my $has_locales = locales_enabled('LC_CTYPE');
my $utf8_locale = find_utf8_ctype_locale();
-plan tests => 1315; # Update this when adding/deleting tests.
+plan tests => 1588; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -36,6 +36,319 @@ run_tests() unless caller;
# Tests start here.
#
sub run_tests {
+ {
+ my $haystack = ("A" x 5000) . "cat";
+ ok($haystack =~ /walrus|cat/, 'AC finds a literal after a long rejected run');
+
+ $haystack = ("A" x 5000) . "dog";
+ ok($haystack !~ /walrus|cat/, 'AC rejects a long run with no literal');
+
+ my $zero_shift_match = "cacc" . ("c" x 5000);
+ ok($zero_shift_match =~ /acc|zdd/ && $-[0] == 1,
+ 'AC zero-shift rejection does not skip a later match');
+
+ my $zero_shift_run = ("c" x 5000) . "acc";
+ ok($zero_shift_run =~ /acc|zdd/ && $-[0] == 5000,
+ 'AC zero-shift map rejection skips a repeated octet run');
+
+ utf8::upgrade($zero_shift_run);
+ ok($zero_shift_run =~ /acc|zdd/ && $-[0] == 5000,
+ 'AC zero-shift map rejection skips an ASCII run in UTF-8');
+
+ $zero_shift_run = "c" x 5000;
+ ok($zero_shift_run !~ /acc|zdd/,
+ 'AC zero-shift map rejection handles a run ending at string end');
+
+ my $shift_one_run = ("e" x 5000) . "fghijY";
+ ok($shift_one_run =~ /abcdeX|fghijY/ && $-[0] == 5000,
+ 'AC repeated-sequence scan handles rejected starts with shift one');
+
+ utf8::upgrade($shift_one_run);
+ ok($shift_one_run =~ /abcdeX|fghijY/ && $-[0] == 5000,
+ 'AC shift-one repeated-sequence scan handles UTF-8 targets');
+
+ $shift_one_run = "e" x 5000;
+ ok($shift_one_run !~ /abcdeX|fghijY/,
+ 'AC shift-one repeated-sequence scan rejects a long non-match');
+
+ my $alternating_run = ("AB" x 5001) . "barB";
+ ok($alternating_run =~ /fooA|barB/ && $-[0] == 10002,
+ 'AC skips repeated UV blocks with rejected alternating starts');
+
+ for my $offset (0 .. 7) {
+ my $aligned_run = ("X" x $offset) . ("AB" x 5000) . "barB";
+ ok($aligned_run =~ /fooA|barB/ && $-[0] == $offset + 10000,
+ "AC repeated-block scan finds the match at offset $offset");
+ }
+
+ utf8::upgrade($alternating_run);
+ ok($alternating_run =~ /fooA|barB/ && $-[0] == 10002,
+ 'AC skips repeated UV blocks in a UTF-8 target');
+
+ for my $offset (0 .. 7) {
+ my $aligned_run = ("X" x $offset) . ("AB" x 5000) . "barB";
+ utf8::upgrade($aligned_run);
+ ok($aligned_run =~ /fooA|barB/ && $-[0] == $offset + 10000,
+ "AC UTF-8 repeated-block scan finds offset $offset");
+ }
+
+ my $wide_alternating_run = ("\x{100}" x 5001) . "ba\x{200}";
+ ok($wide_alternating_run =~ /fo\x{100}|ba\x{200}/
+ && $-[0] == 5001,
+ 'AC skips repeated UTF-8 character blocks at character boundaries');
+
+ $wide_alternating_run = "\x{100}" x 5001;
+ ok($wide_alternating_run !~ /fo\x{100}|ba\x{200}/,
+ 'AC rejects repeated UTF-8 character blocks without a match');
+
+ $haystack = ("A" x 5000) . "cat";
+ ok($haystack =~ /(?:|walrus|cat)/ && $-[0] == 0 && $+[0] == 0,
+ 'AC with an empty alternative keeps the earliest empty match');
+
+ my $six_octet_haystack = ("A" x 5000) . "catcat";
+ ok($six_octet_haystack =~ /walruswalrus|catcat/,
+ 'AC combined prefilter handles six-octet literals');
+
+ $six_octet_haystack = ("A" x 5000) . "dogdog";
+ ok($six_octet_haystack !~ /walruswalrus|catcat/,
+ 'AC combined prefilter rejects a six-octet near miss');
+
+ my $seven_octet_haystack = ("A" x 5000) . "catcatx";
+ ok($seven_octet_haystack =~ /walrusx|catcatx/,
+ 'AC combined prefilter handles seven-octet literals');
+
+ $seven_octet_haystack = ("x" x 5000);
+ ok($seven_octet_haystack !~ /walrusx|catcatx/,
+ 'AC BMH prefilter handles frequent anchor-octet candidates');
+
+ my $long_haystack = ("A" x 5000) . "catcatcatcat";
+ ok($long_haystack =~ /walruswalruswalruswalrus|catcatcatcat/,
+ 'AC BMH prefilter finds a long literal after rejected input');
+
+ $long_haystack = ("A" x 5000) . "dogdogdogdog";
+ ok($long_haystack !~ /walruswalruswalruswalrus|catcatcatcat/,
+ 'AC BMH prefilter rejects a long run with no literal');
+
+ my $very_long_a = "walrus" x 50;
+ my $very_long_b = "cat" x 100;
+ my $very_long_re = qr/\Q$very_long_a\E|\Q$very_long_b\E/;
+ my $very_long_haystack = ("A" x 5000) . $very_long_b;
+ ok($very_long_haystack =~ $very_long_re,
+ 'AC BMH prefilter finds a 300-octet literal with capped shifts');
+
+ $very_long_haystack = ("A" x 5000) . ("dog" x 100);
+ ok($very_long_haystack !~ $very_long_re,
+ 'AC BMH prefilter rejects a 300-octet near miss');
+
+ my @letters = 'a' .. 'z';
+ my @many_literals = map {
+ $letters[$_ % @letters] . sprintf('%06d', $_)
+ } 0 .. 255;
+ my $many_pattern = join '|', map { quotemeta($_) } @many_literals;
+ my $many_re = qr/(?:$many_pattern)/;
+ my $many_haystack = ("Z" x 5000) . $many_literals[-1];
+ ok($many_haystack =~ $many_re && $-[0] == 5000,
+ 'AC high-alternative-count prefilter finds a late match');
+
+ $many_haystack = "Z" x 5000;
+ ok($many_haystack !~ $many_re,
+ 'AC high-alternative-count prefilter rejects a non-match');
+
+ my $overlap_haystack = ("A" x 5000) . "abcdefghijk";
+ ok($overlap_haystack =~ /abcdefghij|defghijk/ && $-[0] == 5000
+ && $+[0] == 5010,
+ 'AC BMH preserves the leftmost overlapping match');
+
+ my $utf8_ascii_haystack = ("A" x 5000) . "cat";
+ utf8::upgrade($utf8_ascii_haystack);
+ ok($utf8_ascii_haystack =~ /walrus|cat/ && $-[0] == 5000,
+ 'AC start-octet table works for UTF-8 invariant literals');
+
+ my $latin1_ascii_haystack = ("A" x 5000) . "cat";
+ utf8::downgrade($latin1_ascii_haystack, 1);
+ ok($latin1_ascii_haystack =~ /walrus|cat/ && $-[0] == 5000,
+ 'AC start-octet table works for Latin-1 invariant literals');
+
+ my $wide_only_re = qr/\x{400}foo|\x{800}bar/;
+ my $latin1_wide_haystack = "A" x 5000;
+ ok($latin1_wide_haystack !~ $wide_only_re,
+ 'AC with only wide literals rejects a Latin-1 target');
+
+ my $utf8_wide_haystack = ("A" x 5000) . "\x{800}bar";
+ utf8::upgrade($utf8_wide_haystack);
+ ok($utf8_wide_haystack =~ $wide_only_re && $-[0] == 5000,
+ 'AC with only wide literals still matches a UTF-8 target');
+
+ my $mixed_wide_re = qr/\x{400}foo|cat/;
+ $latin1_wide_haystack .= "cat";
+ ok($latin1_wide_haystack =~ $mixed_wide_re && $-[0] == 5000,
+ 'AC wide-literal shortcut preserves Latin-1 alternatives');
+
+ ok("abc" =~ /(?:|\x{400}foo)/ && $-[0] == 0 && $+[0] == 0,
+ 'AC wide-literal shortcut preserves an empty alternative');
+
+ my $trie_wide_re = qr/common\x{400}foo|common\x{800}bar/;
+ my $latin1_trie_haystack = ("X" x 5000) . "common";
+ ok($latin1_trie_haystack !~ $trie_wide_re,
+ 'Trie with only wide suffixes rejects a Latin-1 target');
+
+ my $utf8_trie_haystack = ("X" x 5000) . "common\x{800}bar";
+ utf8::upgrade($utf8_trie_haystack);
+ ok($utf8_trie_haystack =~ $trie_wide_re && $-[0] == 5000,
+ 'Trie with only wide suffixes still matches a UTF-8 target');
+ my $mixed_trie_re = qr/common\x{400}foo|commoncat/;
+ $latin1_trie_haystack .= "cat";
+ ok($latin1_trie_haystack =~ $mixed_trie_re && $-[0] == 5000,
+ 'Trie wide-literal shortcut preserves Latin-1 alternatives');
+
+ my $utf8_haystack = ("\x{e9}" x 5000) . "\x{e9}cat";
+ utf8::upgrade($utf8_haystack);
+ ok($utf8_haystack =~ /\x{e9}cat|zebra/,
+ 'UTF-8 AC finds a multi-byte literal after rejected input');
+
+ my $latin1_haystack = ("\xE9" x 5000) . "\xE9cat";
+ ok($latin1_haystack =~ /\x{e9}cat|zebra/,
+ 'Latin-1 AC preserves matching for an awkward code point');
+
+ for my $encoding ('Latin-1', 'UTF-8') {
+ # The shortest word occupies two Latin-1 octets or three UTF-8
+ # octets. Check both alternatives with each target encoding.
+ my $different_lengths_re = qr/\x{e9}a|zbc/;
+
+ for my $suffix ("\x{e9}a", 'zbc') {
+ my $target = ('Q' x 17) . $suffix;
+ utf8::upgrade($target) if $encoding eq 'UTF-8';
+
+ ok($target =~ $different_lengths_re && $-[0] == 17
+ && $+[0] == length($target),
+ "AC uses the effective literal length for $encoding");
+ }
+
+ # Excluding the wide word gives a nine-octet Latin-1 minimum.
+ # Including it gives a three-octet UTF-8 minimum.
+ my $mixed_lengths_re = qr/\x{100}x|abcdefghi/;
+ my $mixed_target = ('x' x 17) . 'abcdefghi';
+ utf8::upgrade($mixed_target) if $encoding eq 'UTF-8';
+
+ ok($mixed_target =~ $mixed_lengths_re && $-[0] == 17,
+ "AC mixed wide alternatives find a narrow word in $encoding");
+
+ $mixed_target = 'x' x 17;
+ utf8::upgrade($mixed_target) if $encoding eq 'UTF-8';
+
+ ok($mixed_target !~ $mixed_lengths_re,
+ "AC mixed wide alternatives reject a short miss in $encoding");
+
+ my $root_restart = ('a' x 17) . 'de';
+ utf8::upgrade($root_restart) if $encoding eq 'UTF-8';
+
+ ok($root_restart =~ /abc|de/ && $-[0] == 17 && $+[0] == 19,
+ "AC resets the point ring on repeated root transitions in $encoding");
+
+ my $fallback_target = 'abcdgu';
+ utf8::upgrade($fallback_target) if $encoding eq 'UTF-8';
+
+ ok($fallback_target =~ /abcdefg|cdgu/
+ && $-[0] == 2 && $+[0] == 6,
+ "AC keeps the point ring across a suffix failure transition in $encoding");
+
+ my $retry_target = 'abcdX';
+ utf8::upgrade($retry_target) if $encoding eq 'UTF-8';
+
+ ok($retry_target =~ /(?:abc|bcd)X/ && $-[0] == 1 && $+[0] == 5,
+ "AC retries an overlapping start after full-match rejection in $encoding");
+
+ # Prefilters are disabled for folds, but the point-ring changes
+ # apply there too. One sharp s contributes two folded characters.
+ for my $case (["\x{df}x", 0, 2],
+ ["s\x{df}x", 1, 3],
+ ["s\x{df}ssx", 2, 5])
+ {
+ my ($target, $start, $end) = @$case;
+ utf8::upgrade($target) if $encoding eq 'UTF-8';
+
+ ok($target =~ /ssx|ab/iu && $-[0] == $start && $+[0] == $end,
+ "AC keeps folded character offsets after root restarts in $encoding");
+ }
+
+ my $partial_fold = "\x{df}x";
+ utf8::upgrade($partial_fold) if $encoding eq 'UTF-8';
+
+ ok($partial_fold !~ /sx|ab/iu,
+ "AC rejects a match starting inside a multi-character fold in $encoding");
+
+ # Each unit's octets are rejected by the start map, but occur at
+ # BMH anchors. Vary the alignment and the repeated word content.
+ for my $unit ('A', 'AB', 'AABB', 'AAAABBBB') {
+ for my $offset (0 .. 7) {
+ my $run = ('X' x $offset) . ($unit x 8);
+ my $late_match = $run . 'barB';
+ utf8::upgrade($late_match) if $encoding eq 'UTF-8';
+
+ ok($late_match =~ /fooA|barB/
+ && $-[0] == length($run)
+ && $+[0] == length($late_match),
+ "AC $encoding repeated '$unit' finds a match at alignment $offset");
+
+ utf8::upgrade($run) if $encoding eq 'UTF-8';
+
+ ok($run !~ /fooA|barB/,
+ "AC $encoding repeated '$unit' rejects a miss at alignment $offset");
+ }
+ }
+
+ # Include runs shorter than a UV and tails shorter than a UV.
+ # The helper must not read beyond the buffer or miss its last start.
+ for my $run_length (0 .. 15) {
+ my $short_run = 'A' x $run_length;
+ my $last_match = $short_run . 'barB';
+ utf8::upgrade($last_match) if $encoding eq 'UTF-8';
+
+ ok($last_match =~ /fooA|barB/ && $-[0] == $run_length,
+ "AC $encoding short repeated run of length $run_length finds the last start");
+
+ utf8::upgrade($short_run) if $encoding eq 'UTF-8';
+
+ ok($short_run !~ /fooA|barB/,
+ "AC $encoding short repeated run of length $run_length rejects a miss");
+ }
+ }
+
+ my $wide_minimum_target = ('x' x 17) . "\x{100}x";
+ ok($wide_minimum_target =~ /\x{100}x|abcdefghi/ && $-[0] == 17,
+ 'AC uses the wide alternative that sets the UTF-8 minimum');
+
+ my $wide_fallback_target = "\x{e9}abc\x{100}du";
+ ok($wide_fallback_target =~ /\x{e9}abcdefg|c\x{100}du/
+ && $-[0] == 3 && $+[0] == 7,
+ 'AC retains character offsets across a wide suffix failure transition');
+
+ # The UTF-8 prefixes exceed the 255-octet cap. Their capped anchor
+ # lies on a continuation octet, which is valid for a BMH lookup.
+ my $long_latin1_word = 'a' . ("\x{e9}" x 150);
+ my $long_wide_word = 'b' . ("\x{100}" x 150);
+ my $long_encoded_re = qr/\Q$long_latin1_word\E|\Q$long_wide_word\E/;
+
+ for my $encoding ('Latin-1', 'UTF-8') {
+ my $target = ('Q' x 17) . $long_latin1_word;
+ utf8::upgrade($target) if $encoding eq 'UTF-8';
+
+ ok($target =~ $long_encoded_re && $-[0] == 17
+ && $+[0] == length($target),
+ "AC long encoded literals match a Latin-1 word in $encoding");
+
+ $target = ('Q' x 17) . 'a' . ("\x{e9}" x 149) . 'z';
+ utf8::upgrade($target) if $encoding eq 'UTF-8';
+
+ ok($target !~ $long_encoded_re,
+ "AC long encoded literals reject a near miss in $encoding");
+ }
+
+ my $long_wide_target = ('Q' x 17) . $long_wide_word;
+ ok($long_wide_target =~ $long_encoded_re && $-[0] == 17,
+ 'AC capped shifts find a long wide word through continuation anchors');
+ }
+
{
# see https://github.com/Perl/perl5/issues/12948
my $string="ABCDEFGHIJKL";