STATIC CHECKPOINT
S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen)
{
- dVAR;
const int retval = PL_savestack_ix;
const int paren_elems_to_push =
(maxopenparen - parenfloor) * REGCP_PAREN_ELEMS;
PERL_ARGS_ASSERT_REGCPPUSH;
if (paren_elems_to_push < 0)
- Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %i",
- paren_elems_to_push, maxopenparen, parenfloor, REGCP_PAREN_ELEMS);
+ Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %u",
+ (int)paren_elems_to_push, (int)maxopenparen,
+ (int)parenfloor, (unsigned)REGCP_PAREN_ELEMS);
if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
STATIC void
S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
{
- dVAR;
UV i;
U32 paren;
GET_RE_DEBUG_FLAGS_DECL;
const U32 flags,
re_scream_pos_data *data)
{
- dVAR;
struct regexp *const prog = ReANY(rx);
SSize_t start_shift = prog->check_offset_min;
/* Should be nonnegative! */
});
if (prog->intflags & PREGf_ANCH) { /* Match at \G, beg-of-str or after \n */
- /* Check after \n? */
- ml_anch = (prog->intflags & PREGf_ANCH_MBOL);
+
+ /* ml_anch: check after \n?
+ *
+ * A note about IMPLICIT: on an un-anchored pattern beginning
+ * with /.*.../, these flags will have been added by the
+ * compiler:
+ * /.*abc/, /.*abc/m: PREGf_IMPLICIT | PREGf_ANCH_MBOL
+ * /.*abc/s: PREGf_IMPLICIT | PREGf_ANCH_SBOL
+ */
+ ml_anch = (prog->intflags & PREGf_ANCH_MBOL)
+ && !(prog->intflags & PREGf_IMPLICIT);
if (!ml_anch && !(prog->intflags & PREGf_IMPLICIT)) {
/* we are only allowed to match at BOS or \G */
* based on pos() and gofs, so the string is already correctly
* anchored by definition; and handling the exceptions would
* be too fiddly (e.g. REXEC_IGNOREPOS).
- *
- * A note about IMPLICIT: on an un-anchored pattern beginning
- * with /.*.../, these flags will have been added by the
- * compiler:
- * /.*abc/, /.*abc/m: PREGf_IMPLICIT | PREGf_ANCH_MBOL
- * /.*abc/s: PREGf_IMPLICIT | PREGf_ANCH_SBOL
- * so just the presence of SBOL isn't enough to guarantee
- * that we're anchored.
*/
if ( strpos != strbeg
&& (prog->intflags & (PREGf_ANCH_BOL|PREGf_ANCH_SBOL)))
" Looking for check substr at fixed offset %"IVdf"...\n",
(IV)prog->check_offset_min));
- if (SvTAIL(check) && !multiline) {
- /* In this case, the regex is anchored at the end too,
- * so the lengths must match exactly, give or take a \n.
- * NB: slen >= 1 since the last char of check is \n */
- if ( strend - s > slen || strend - s < slen - 1
- || (strend - s == slen && strend[-1] != '\n'))
+ if (SvTAIL(check)) {
+ /* In this case, the regex is anchored at the end too.
+ * Unless it's a multiline match, the lengths must match
+ * exactly, give or take a \n. NB: slen >= 1 since
+ * the last char of check is \n */
+ if (!multiline
+ && ( strend - s > slen
+ || strend - s < slen - 1
+ || (strend - s == slen && strend[-1] != '\n')))
{
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
" String too long...\n"));
*/
if (!ml_anch
&& prog->intflags & PREGf_ANCH
- && !(prog->intflags & PREGf_IMPLICIT)
&& prog->check_offset_max != SSize_t_MAX)
{
SSize_t len = SvCUR(check) - !!SvTAIL(check);
/* handle the extra constraint of /^.../m if present */
- if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n'
- /* May be due to an implicit anchor of m{.*foo} */
- && !(prog->intflags & PREGf_IMPLICIT))
- {
+ if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n') {
char *s;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
* find_byclass().
*/
- if (prog->anchored_substr || prog->anchored_utf8 || (ml_anch && !(prog->intflags & PREGf_IMPLICIT)))
+ if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
endpos= HOP3c(rx_origin, (prog->minlen ? cl_l : 0), strend);
else if (prog->float_substr || prog->float_utf8) {
rx_max_float = HOP3c(check_at, -start_shift, strbeg);
else {
/* float-only */
- if (ml_anch && !(prog->intflags & PREGf_IMPLICIT)) {
+ if (ml_anch) {
/* In the presence of ml_anch, we might be able to
* find another \n without breaking the current float
* constraint. */
prog->check_substr = prog->check_utf8 = NULL; /* disable */
prog->float_substr = prog->float_utf8 = NULL; /* clear */
check = NULL; /* abort */
- /* XXXX If the check string was an implicit check MBOL, then we need to unset the relevant flag
- see http://bugs.activestate.com/show_bug.cgi?id=87173 */
- if (prog->intflags & PREGf_IMPLICIT) {
- prog->intflags &= ~PREGf_ANCH_MBOL;
- /* maybe we have no anchors left after this... */
- if (!(prog->intflags & PREGf_ANCH))
- prog->extflags &= ~RXf_IS_ANCHORED;
- }
/* XXXX This is a remnant of the old implementation. It
looks wasteful, since now INTUIT can use many
other heuristics. */
prog->extflags &= ~RXf_USE_INTUIT;
- /* XXXX What other flags might need to be cleared in this branch? */
}
}
switch (trie_type) { \
case trie_utf8_exactfa_fold: \
flags |= FOLD_FLAGS_NOMIX_ASCII; \
- /* FALL THROUGH */ \
+ /* FALLTHROUGH */ \
case trie_utf8_fold: \
if ( foldlen>0 ) { \
uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
break; \
case trie_latin_utf8_exactfa_fold: \
flags |= FOLD_FLAGS_NOMIX_ASCII; \
- /* FALL THROUGH */ \
+ /* FALLTHROUGH */ \
case trie_latin_utf8_fold: \
if ( foldlen>0 ) { \
uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
} \
} STMT_END
-#define REXEC_FBC_EXACTISH_SCAN(CoNd) \
+#define REXEC_FBC_EXACTISH_SCAN(COND) \
STMT_START { \
while (s <= e) { \
- if ( (CoNd) \
+ if ( (COND) \
&& (ln == 1 || folder(s, pat_string, ln)) \
&& (reginfo->intuit || regtry(reginfo, &s)) )\
goto got_it; \
} \
} STMT_END
-#define REXEC_FBC_UTF8_SCAN(CoDe) \
+#define REXEC_FBC_UTF8_SCAN(CODE) \
STMT_START { \
while (s < strend) { \
- CoDe \
+ CODE \
s += UTF8SKIP(s); \
} \
} STMT_END
-#define REXEC_FBC_SCAN(CoDe) \
+#define REXEC_FBC_SCAN(CODE) \
STMT_START { \
while (s < strend) { \
- CoDe \
+ CODE \
s++; \
} \
} STMT_END
-#define REXEC_FBC_UTF8_CLASS_SCAN(CoNd) \
+#define REXEC_FBC_UTF8_CLASS_SCAN(COND) \
REXEC_FBC_UTF8_SCAN( \
- if (CoNd) { \
+ if (COND) { \
if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
goto got_it; \
else \
tmp = 1; \
)
-#define REXEC_FBC_CLASS_SCAN(CoNd) \
+#define REXEC_FBC_CLASS_SCAN(COND) \
REXEC_FBC_SCAN( \
- if (CoNd) { \
+ if (COND) { \
if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
goto got_it; \
else \
if ((reginfo->intuit || regtry(reginfo, &s))) \
goto got_it
-#define REXEC_FBC_CSCAN(CoNdUtF8,CoNd) \
+#define REXEC_FBC_CSCAN(CONDUTF8,COND) \
if (utf8_target) { \
- REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \
+ REXEC_FBC_UTF8_CLASS_SCAN(CONDUTF8); \
} \
else { \
- REXEC_FBC_CLASS_SCAN(CoNd); \
+ REXEC_FBC_CLASS_SCAN(COND); \
}
#define DUMP_EXEC_POS(li,s,doutf8) \
} \
); \
-#define UTF8_LOAD(TeSt1_UtF8, TeSt2_UtF8, IF_SUCCESS, IF_FAIL) \
+#define UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, IF_SUCCESS, IF_FAIL) \
if (s == reginfo->strbeg) { \
tmp = '\n'; \
} \
tmp = utf8n_to_uvchr(r, (U8*) reginfo->strend - r, \
0, UTF8_ALLOW_DEFAULT); \
} \
- tmp = TeSt1_UtF8; \
+ tmp = TEST1_UTF8; \
LOAD_UTF8_CHARCLASS_ALNUM(); \
REXEC_FBC_UTF8_SCAN( \
- if (tmp == ! (TeSt2_UtF8)) { \
+ if (tmp == ! (TEST2_UTF8)) { \
tmp = !tmp; \
IF_SUCCESS; \
} \
case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */
assert(! is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA:
if (is_utf8_pat || utf8_target) {
utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
fold_array = PL_fold_latin1;
folder = foldEQ_latin1;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there
are no glitches with fold-length differences
case NPOSIXA:
if (utf8_target) {
/* The complement of something that matches only ASCII matches all
- * UTF-8 variant code points, plus everything in ASCII that isn't
- * in the class */
- REXEC_FBC_UTF8_CLASS_SCAN(! UTF8_IS_INVARIANT(*s)
+ * non-ASCII, plus everything in ASCII that isn't in the class. */
+ REXEC_FBC_UTF8_CLASS_SCAN(! isASCII_utf8(s)
|| ! _generic_isCC_A(*s, FLAGS(c)));
break;
}
macros */
case _CC_ENUM_SPACE: /* XXX would require separate code if we
revert the change of \v matching this */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case _CC_ENUM_PSXSPC:
REXEC_FBC_UTF8_CLASS_SCAN(
break;
default:
Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
- break;
}
return 0;
got_it:
/* flags: For optimizations. See REXEC_* in regexp.h */
{
- dVAR;
struct regexp *const prog = ReANY(rx);
char *s;
regnode *c;
/* Be paranoid... */
if (prog == NULL || stringarg == NULL) {
Perl_croak(aTHX_ "NULL regexp parameter");
- return 0;
}
DEBUG_EXECUTE_r(
Perl_croak(aTHX_ "corrupted regexp program");
}
+ RX_MATCH_TAINTED_off(rx);
+
reginfo->prog = rx; /* Yes, sorry that this is confusing. */
reginfo->intuit = 0;
reginfo->is_utf8_target = cBOOL(utf8_target);
STATIC I32 /* 0 failure, 1 success */
S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
{
- dVAR;
CHECKPOINT lastcp;
REGEXP *const rx = reginfo->prog;
regexp *const prog = ReANY(rx);
* or 0 if non of the buffers matched.
*/
STATIC I32
-S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan)
+S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan)
{
I32 n;
RXi_GET_DECL(rex,rexi);
}
else { /* an EXACTFish node which doesn't begin with a multi-char fold */
c1 = is_utf8_pat ? valid_utf8_to_uvchr(pat, NULL) : *pat;
- if (c1 > 256) {
+ if (c1 > 255) {
/* Load the folds hash, if not already done */
SV** listp;
if (! PL_utf8_foldclosures) {
- if (! PL_utf8_tofold) {
- U8 dummy[UTF8_MAXBYTES_CASE+1];
-
- /* Force loading this by folding an above-Latin1 char */
- to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL);
- assert(PL_utf8_tofold); /* Verify that worked */
- }
- PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold);
+ _load_PL_utf8_foldclosures();
}
/* The fold closures data structure is a hash with the keys
/* Folds that cross the 255/256 boundary are forbidden
* if EXACTFL (and isnt a UTF8 locale), or EXACTFA and
* one is ASCIII. Since the pattern character is above
- * 256, and its only other match is below 256, the only
+ * 255, and its only other match is below 256, the only
* legal match will be to itself. We have thrown away
* the original, so have to compute which is the one
- * above 255 */
+ * above 255. */
if ((c1 < 256) != (c2 < 256)) {
if ((OP(text_node) == EXACTFL
&& ! IN_UTF8_CTYPE_LOCALE)
}
}
}
- else /* Here, c1 is < 255 */
+ else /* Here, c1 is <= 255 */
if (utf8_target
&& HAS_NONLATIN1_FOLD_CLOSURE(c1)
&& ( ! (OP(text_node) == EXACTFL && ! IN_UTF8_CTYPE_LOCALE))
case EXACTFA_NO_TRIE: /* This node only generated for
non-utf8 patterns */
assert(! is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA:
case EXACTFU_SS:
case EXACTFU:
break;
case EOL: /* /..$/ */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case SEOL: /* /..$/s */
if (!NEXTCHR_IS_EOS && nextchr != '\n')
sayNO;
sayNO_SILENT;
assert(0); /* NOTREACHED */
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case TRIE: /* (ab|cd) */
/* the basic plan of execution of the trie is:
* At the beginning, run though all the states, and
case EXACTFA_NO_TRIE: /* This node only generated for non-utf8
patterns */
assert(! is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA: /* /abc/iaa */
folder = foldEQ_latin1;
fold_array = PL_fold_latin1;
break;
default:
Perl_croak(aTHX_ "panic: Unexpected FLAGS %u in op %u", FLAGS(scan), OP(scan));
- break;
}
}
/* Note requires that all BOUNDs be lower than all NBOUNDs in
assert(0); /* NOTREACHED */
case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case WHILEM_A_pre_fail: /* just failed to match even minimal A */
REGCP_UNWIND(ST.lastcp);
regcppop(rex, &maxopenparen);
if (next == scan)
next = NULL;
scan = NEXTOPER(scan);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case BRANCH: /* /(...|A|...)/ */
scan = NEXTOPER(scan); /* scan now points to inner node */
assert(0); /* NOTREACHED */
}
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case CURLY_B_max_fail:
/* failed to find B in a greedy match */
case IFMATCH_A_fail: /* body of (?...A) failed */
ST.wanted = !ST.wanted;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case IFMATCH_A: /* body of (?...A) succeeded */
if (ST.logical) {
/* push a state that backtracks on success */
st->u.yes.prev_yes_state = yes_state;
yes_state = st;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
push_state:
/* push a new regex state, then continue at scan */
{
sv_commit = &PL_sv_yes;
sv_yes_mark = &PL_sv_no;
}
+ assert(sv_err);
+ assert(sv_mrk);
sv_setsv(sv_err, sv_commit);
sv_setsv(sv_mrk, sv_yes_mark);
}
S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
regmatch_info *const reginfo, I32 max, int depth)
{
- dVAR;
char *scan; /* Pointer to current position in target string */
I32 c;
char *loceol = reginfo->strend; /* local version */
case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */
assert(! reginfo->is_utf8_pat);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case EXACTFA:
utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
goto do_exactf;
to_complement = 1;
goto utf8_posix;
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case NPOSIXA:
if (! utf8_target) {
else {
/* The complement of something that matches only ASCII matches all
- * UTF-8 variant code points, plus everything in ASCII that isn't
- * in the class. */
+ * non-ASCII, plus everything in ASCII that isn't in the class. */
while (hardcount < max && scan < loceol
- && (! UTF8_IS_INVARIANT(*scan)
+ && (! isASCII_utf8(scan)
|| ! _generic_isCC_A((U8) *scan, FLAGS(p))))
{
scan += UTF8SKIP(scan);
case _CC_ENUM_SPACE: /* XXX would require separate code
if we revert the change of \v
matching this */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case _CC_ENUM_PSXSPC:
while (hardcount < max
&& scan < loceol
* swash are returned (in a printable form).
* Tied intimately to how regcomp.c sets up the data structure */
- dVAR;
SV *sw = NULL;
SV *si = NULL; /* Input swash initialization string */
SV* invlist = NULL;
*only_utf8_locale_ptr = ary[2];
}
else {
+ assert(only_utf8_locale_ptr);
*only_utf8_locale_ptr = NULL;
}
}
else if (doinit && ((si && si != &PL_sv_undef)
|| (invlist && invlist != &PL_sv_undef))) {
-
+ assert(si);
sw = _core_swash_init("utf8", /* the utf8 package */
"", /* nameless */
si,
/* If requested, return a printable version of what this swash matches */
if (listsvp) {
- SV* matches_string = newSVpvn("", 0);
+ SV* matches_string = newSVpvs("");
/* The swash should be used, if possible, to get the data, as it
* contains the resolved data. But this function can be called at
SV * const sw = _get_regclass_nonbitmap_data(prog, n, TRUE, 0,
&only_utf8_locale);
if (sw) {
+ U8 utf8_buffer[2];
U8 * utf8_p;
if (utf8_target) {
utf8_p = (U8 *) p;
} else { /* Convert to utf8 */
- STRLEN len = 1;
- utf8_p = bytes_to_utf8(p, &len);
+ utf8_p = utf8_buffer;
+ append_utf8_from_native_byte(*p, &utf8_p);
+ utf8_p = utf8_buffer;
}
if (swash_fetch(sw, utf8_p, TRUE)) {
match = TRUE;
}
-
- /* If we allocated a string above, free it */
- if (! utf8_target) Safefree(utf8_p);
}
if (! match && only_utf8_locale && IN_UTF8_CTYPE_LOCALE) {
match = _invlist_contains_cp(only_utf8_locale, c);
* 'off' >= 0, backwards if negative. But don't go outside of position
* 'lim', which better be < s if off < 0 */
- dVAR;
-
PERL_ARGS_ASSERT_REGHOP3;
if (off >= 0) {
STATIC U8 *
S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGHOP4;
if (off >= 0) {
STATIC U8 *
S_reghopmaybe3(U8* s, SSize_t off, const U8* lim)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGHOPMAYBE3;
if (off >= 0) {
static void
S_cleanup_regmatch_info_aux(pTHX_ void *arg)
{
- dVAR;
regmatch_info_aux *aux = (regmatch_info_aux *) arg;
regmatch_info_aux_eval *eval_state = aux->info_aux_eval;
regmatch_slab *s;
/* Converts substr fields in prog from UTF-8 to bytes, calling fbm_compile
* on the converted value; returns FALSE if can't be converted. */
- dVAR;
int i = 1;
PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;
https://perl5.git.perl.org / perl5.git / blobdiff