/* At least one required character in the target string is expressible only in
* UTF-8. */
-const char* const non_utf8_target_but_utf8_required
+static const char* const non_utf8_target_but_utf8_required
= "Can't match, because target string needs to be in UTF-8\n";
+#define NON_UTF8_TARGET_BUT_UTF8_REQUIRED(target) STMT_START { \
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s", non_utf8_target_but_utf8_required));\
+ goto target; \
+} STMT_END
+
/*
* pregcomp and pregexec -- regsub and regerror are not used in perl
*
#include "inline_invlist.c"
#include "unicode_constants.h"
-#define RF_tainted 1 /* tainted information used? e.g. locale */
-#define RF_warned 2 /* warned about big count? */
-
-#define RF_utf8 8 /* Pattern contains multibyte chars? */
-
-#define UTF_PATTERN ((PL_reg_flags & RF_utf8) != 0)
-
#define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
#ifndef STATIC
#define STATIC static
#endif
-/* Valid for non-utf8 strings, non-ANYOFV nodes only: avoids the reginclass
+/* Valid for non-utf8 strings: avoids the reginclass
* call if there are no complications: i.e., if everything matchable is
* straight forward in the bitmap */
-#define REGINCLASS(prog,p,c) (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0,0) \
+#define REGINCLASS(prog,p,c) (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0) \
: ANYOF_BITMAP_TEST(p,*(c)))
/*
*/
#define CHR_SVLEN(sv) (utf8_target ? sv_len_utf8(sv) : SvCUR(sv))
-#define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
+#define CHR_DIST(a,b) (reginfo->is_utf8_target ? utf8_distance(a,b) : a - b)
#define HOPc(pos,off) \
- (char *)(PL_reg_match_utf8 \
- ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
+ (char *)(reginfo->is_utf8_target \
+ ? reghop3((U8*)pos, off, \
+ (U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \
: (U8*)(pos + off))
#define HOPBACKc(pos, off) \
- (char*)(PL_reg_match_utf8\
- ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
- : (pos - off >= PL_bostr) \
+ (char*)(reginfo->is_utf8_target \
+ ? reghopmaybe3((U8*)pos, -off, (U8*)(reginfo->strbeg)) \
+ : (pos - off >= reginfo->strbeg) \
? (U8*)pos - off \
: NULL)
-#define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
+#define HOP3(pos,off,lim) (reginfo->is_utf8_target ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
#define NEXTCHR_IS_EOS (nextchr < 0)
#define SET_nextchr \
- nextchr = ((locinput < PL_regeol) ? UCHARAT(locinput) : NEXTCHR_EOS)
+ nextchr = ((locinput < reginfo->strend) ? UCHARAT(locinput) : NEXTCHR_EOS)
#define SET_locinput(p) \
locinput = (p); \
SET_nextchr
-/* these are unrolled below in the CCC_TRY_XXX defined */
-#define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
- if (!CAT2(PL_utf8_,class)) { \
- bool ok; \
- ENTER; save_re_context(); \
- ok=CAT2(is_utf8_,class)((const U8*)str); \
- PERL_UNUSED_VAR(ok); \
- assert(ok); assert(CAT2(PL_utf8_,class)); LEAVE; } } STMT_END
-/* Doesn't do an assert to verify that is correct */
-#define LOAD_UTF8_CHARCLASS_NO_CHECK(class) STMT_START { \
- if (!CAT2(PL_utf8_,class)) { \
- bool throw_away PERL_UNUSED_DECL; \
- ENTER; save_re_context(); \
- throw_away = CAT2(is_utf8_,class)((const U8*)" "); \
- LEAVE; } } STMT_END
-
-#define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
-#define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
-#define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
-
-#define LOAD_UTF8_CHARCLASS_GCB() /* Grapheme cluster boundaries */ \
- /* No asserts are done for some of these, in case called on a */ \
- /* Unicode version in which they map to nothing */ \
- LOAD_UTF8_CHARCLASS(X_regular_begin, HYPHEN_UTF8); \
- LOAD_UTF8_CHARCLASS(X_extend, COMBINING_GRAVE_ACCENT_UTF8); \
+#define LOAD_UTF8_CHARCLASS(swash_ptr, property_name) STMT_START { \
+ if (!swash_ptr) { \
+ U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST; \
+ swash_ptr = _core_swash_init("utf8", property_name, &PL_sv_undef, \
+ 1, 0, NULL, &flags); \
+ assert(swash_ptr); \
+ } \
+ } STMT_END
-#define PLACEHOLDER /* Something for the preprocessor to grab onto */
+/* If in debug mode, we test that a known character properly matches */
+#ifdef DEBUGGING
+# define LOAD_UTF8_CHARCLASS_DEBUG_TEST(swash_ptr, \
+ property_name, \
+ utf8_char_in_property) \
+ LOAD_UTF8_CHARCLASS(swash_ptr, property_name); \
+ assert(swash_fetch(swash_ptr, (U8 *) utf8_char_in_property, TRUE));
+#else
+# define LOAD_UTF8_CHARCLASS_DEBUG_TEST(swash_ptr, \
+ property_name, \
+ utf8_char_in_property) \
+ LOAD_UTF8_CHARCLASS(swash_ptr, property_name)
+#endif
-/* The actual code for CCC_TRY, which uses several variables from the routine
- * it's callable from. It is designed to be the bulk of a case statement.
- * FUNC is the macro or function to call on non-utf8 targets that indicate if
- * nextchr matches the class.
- * UTF8_TEST is the whole test string to use for utf8 targets
- * LOAD is what to use to test, and if not present to load in the swash for the
- * class
- * POS_OR_NEG is either empty or ! to complement the results of FUNC or
- * UTF8_TEST test.
- * The logic is: Fail if we're at the end-of-string; otherwise if the target is
- * utf8 and a variant, load the swash if necessary and test using the utf8
- * test. Advance to the next character if test is ok, otherwise fail; If not
- * utf8 or an invariant under utf8, use the non-utf8 test, and fail if it
- * fails, or advance to the next character */
-
-#define _CCC_TRY_CODE(POS_OR_NEG, FUNC, UTF8_TEST, CLASS, STR) \
- if (NEXTCHR_IS_EOS) { \
- sayNO; \
- } \
- if (utf8_target && UTF8_IS_CONTINUED(nextchr)) { \
- LOAD_UTF8_CHARCLASS(CLASS, STR); \
- if (POS_OR_NEG (UTF8_TEST)) { \
- sayNO; \
- } \
- } \
- else if (POS_OR_NEG (FUNC(nextchr))) { \
- sayNO; \
- } \
- goto increment_locinput;
-
-/* Handle the non-locale cases for a character class and its complement. It
- * calls _CCC_TRY_CODE with a ! to complement the test for the character class.
- * This is because that code fails when the test succeeds, so we want to have
- * the test fail so that the code succeeds. The swash is stored in a
- * predictable PL_ place */
-#define _CCC_TRY_NONLOCALE(NAME, NNAME, FUNC, \
- CLASS, STR) \
- case NAME: \
- _CCC_TRY_CODE( !, FUNC, \
- cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS), \
- (U8*)locinput, TRUE)), \
- CLASS, STR) \
- case NNAME: \
- _CCC_TRY_CODE( PLACEHOLDER , FUNC, \
- cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS), \
- (U8*)locinput, TRUE)), \
- CLASS, STR) \
-
-/* Generate the case statements for both locale and non-locale character
- * classes in regmatch for classes that don't have special unicode semantics.
- * Locales don't use an immediate swash, but an intermediary special locale
- * function that is called on the pointer to the current place in the input
- * string. That function will resolve to needing the same swash. One might
- * think that because we don't know what the locale will match, we shouldn't
- * check with the swash loading function that it loaded properly; ie, that we
- * should use LOAD_UTF8_CHARCLASS_NO_CHECK for those, but what is passed to the
- * regular LOAD_UTF8_CHARCLASS is in non-locale terms, and so locale is
- * irrelevant here */
-#define CCC_TRY(NAME, NNAME, FUNC, \
- NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8, \
- NAMEA, NNAMEA, FUNCA, \
- CLASS, STR) \
- case NAMEL: \
- PL_reg_flags |= RF_tainted; \
- _CCC_TRY_CODE( !, LCFUNC, LCFUNC_utf8((U8*)locinput), CLASS, STR) \
- case NNAMEL: \
- PL_reg_flags |= RF_tainted; \
- _CCC_TRY_CODE( PLACEHOLDER, LCFUNC, LCFUNC_utf8((U8*)locinput), \
- CLASS, STR) \
- case NAMEA: \
- if (NEXTCHR_IS_EOS || ! FUNCA(nextchr)) { \
- sayNO; \
- } \
- /* Matched a utf8-invariant, so don't have to worry about utf8 */ \
- locinput++; \
- break; \
- case NNAMEA: \
- if (NEXTCHR_IS_EOS || FUNCA(nextchr)) { \
- sayNO; \
- } \
- goto increment_locinput; \
- /* Generate the non-locale cases */ \
- _CCC_TRY_NONLOCALE(NAME, NNAME, FUNC, CLASS, STR)
-
-/* This is like CCC_TRY, but has an extra set of parameters for generating case
- * statements to handle separate Unicode semantics nodes */
-#define CCC_TRY_U(NAME, NNAME, FUNC, \
- NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8, \
- NAMEU, NNAMEU, FUNCU, \
- NAMEA, NNAMEA, FUNCA, \
- CLASS, STR) \
- CCC_TRY(NAME, NNAME, FUNC, \
- NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8, \
- NAMEA, NNAMEA, FUNCA, \
- CLASS, STR) \
- _CCC_TRY_NONLOCALE(NAMEU, NNAMEU, FUNCU, CLASS, STR)
+#define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS_DEBUG_TEST( \
+ PL_utf8_swash_ptrs[_CC_WORDCHAR], \
+ swash_property_names[_CC_WORDCHAR], \
+ GREEK_SMALL_LETTER_IOTA_UTF8)
+
+#define LOAD_UTF8_CHARCLASS_GCB() /* Grapheme cluster boundaries */ \
+ STMT_START { \
+ LOAD_UTF8_CHARCLASS_DEBUG_TEST(PL_utf8_X_regular_begin, \
+ "_X_regular_begin", \
+ GREEK_SMALL_LETTER_IOTA_UTF8); \
+ LOAD_UTF8_CHARCLASS_DEBUG_TEST(PL_utf8_X_extend, \
+ "_X_extend", \
+ COMBINING_GRAVE_ACCENT_UTF8); \
+ } STMT_END
+#define PLACEHOLDER /* Something for the preprocessor to grab onto */
/* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
/* for use after a quantifier and before an EXACT-like node -- japhy */
} \
} STMT_END
+/* These constants are for finding GCB=LV and GCB=LVT in the CLUMP regnode.
+ * These are for the pre-composed Hangul syllables, which are all in a
+ * contiguous block and arranged there in such a way so as to facilitate
+ * alorithmic determination of their characteristics. As such, they don't need
+ * a swash, but can be determined by simple arithmetic. Almost all are
+ * GCB=LVT, but every 28th one is a GCB=LV */
+#define SBASE 0xAC00 /* Start of block */
+#define SCount 11172 /* Length of block */
+#define TCount 28
+
+#define SLAB_FIRST(s) (&(s)->states[0])
+#define SLAB_LAST(s) (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
-static void restore_pos(pTHX_ void *arg);
+static void S_setup_eval_state(pTHX_ regmatch_info *const reginfo);
+static void S_cleanup_regmatch_info_aux(pTHX_ void *arg);
+static regmatch_state * S_push_slab(pTHX);
#define REGCP_PAREN_ELEMS 3
#define REGCP_OTHER_ELEMS 3
* are needed for the regexp context stack bookkeeping. */
STATIC CHECKPOINT
-S_regcppush(pTHX_ const regexp *rex, I32 parenfloor)
+S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen)
{
dVAR;
const int retval = PL_savestack_ix;
- const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
+ const int paren_elems_to_push =
+ (maxopenparen - parenfloor) * REGCP_PAREN_ELEMS;
const UV total_elems = paren_elems_to_push + REGCP_OTHER_ELEMS;
const UV elems_shifted = total_elems << SAVE_TIGHT_SHIFT;
I32 p;
if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
" out of range (%lu-%ld)",
- total_elems, (unsigned long)PL_regsize, (long)parenfloor);
+ total_elems,
+ (unsigned long)maxopenparen,
+ (long)parenfloor);
SSGROW(total_elems + REGCP_FRAME_ELEMS);
DEBUG_BUFFERS_r(
- if ((int)PL_regsize > (int)parenfloor)
+ if ((int)maxopenparen > (int)parenfloor)
PerlIO_printf(Perl_debug_log,
"rex=0x%"UVxf" offs=0x%"UVxf": saving capture indices:\n",
PTR2UV(rex),
PTR2UV(rex->offs)
);
);
- for (p = parenfloor+1; p <= (I32)PL_regsize; p++) {
+ for (p = parenfloor+1; p <= (I32)maxopenparen; p++) {
/* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
SSPUSHINT(rex->offs[p].end);
SSPUSHINT(rex->offs[p].start);
));
}
/* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
- SSPUSHINT(PL_regsize);
+ SSPUSHINT(maxopenparen);
SSPUSHINT(rex->lastparen);
SSPUSHINT(rex->lastcloseparen);
SSPUSHUV(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
STATIC void
-S_regcppop(pTHX_ regexp *rex)
+S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
{
dVAR;
UV i;
i >>= SAVE_TIGHT_SHIFT; /* Parentheses elements to pop. */
rex->lastcloseparen = SSPOPINT;
rex->lastparen = SSPOPINT;
- PL_regsize = SSPOPINT;
+ *maxopenparen_p = SSPOPINT;
i -= REGCP_OTHER_ELEMS;
/* Now restore the parentheses context. */
PTR2UV(rex->offs)
);
);
- paren = PL_regsize;
+ paren = *maxopenparen_p;
for ( ; i > 0; i -= REGCP_PAREN_ELEMS) {
I32 tmps;
rex->offs[paren].start_tmp = SSPOPINT;
* this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
* --jhi updated by dapm */
for (i = rex->lastparen + 1; i <= rex->nparens; i++) {
- if (i > PL_regsize)
+ if (i > *maxopenparen_p)
rex->offs[i].start = -1;
rex->offs[i].end = -1;
DEBUG_BUFFERS_r( PerlIO_printf(Perl_debug_log,
" \\%"UVuf": %s ..-1 undeffing\n",
(UV)i,
- (i > PL_regsize) ? "-1" : " "
+ (i > *maxopenparen_p) ? "-1" : " "
));
}
#endif
* but without popping the stack */
STATIC void
-S_regcp_restore(pTHX_ regexp *rex, I32 ix)
+S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p)
{
I32 tmpix = PL_savestack_ix;
PL_savestack_ix = ix;
- regcppop(rex);
+ regcppop(rex, maxopenparen_p);
PL_savestack_ix = tmpix;
}
#define regcpblow(cp) LEAVE_SCOPE(cp) /* Ignores regcppush()ed data. */
+STATIC bool
+S_isFOO_lc(pTHX_ const U8 classnum, const U8 character)
+{
+ /* Returns a boolean as to whether or not 'character' is a member of the
+ * Posix character class given by 'classnum' that should be equivalent to a
+ * value in the typedef '_char_class_number'.
+ *
+ * Ideally this could be replaced by a just an array of function pointers
+ * to the C library functions that implement the macros this calls.
+ * However, to compile, the precise function signatures are required, and
+ * these may vary from platform to to platform. To avoid having to figure
+ * out what those all are on each platform, I (khw) am using this method,
+ * which adds an extra layer of function call overhead (unless the C
+ * optimizer strips it away). But we don't particularly care about
+ * performance with locales anyway. */
+
+ switch ((_char_class_number) classnum) {
+ case _CC_ENUM_ALPHANUMERIC: return isALPHANUMERIC_LC(character);
+ case _CC_ENUM_ALPHA: return isALPHA_LC(character);
+ case _CC_ENUM_ASCII: return isASCII_LC(character);
+ case _CC_ENUM_BLANK: return isBLANK_LC(character);
+ case _CC_ENUM_CASED: return isLOWER_LC(character)
+ || isUPPER_LC(character);
+ case _CC_ENUM_CNTRL: return isCNTRL_LC(character);
+ case _CC_ENUM_DIGIT: return isDIGIT_LC(character);
+ case _CC_ENUM_GRAPH: return isGRAPH_LC(character);
+ case _CC_ENUM_LOWER: return isLOWER_LC(character);
+ case _CC_ENUM_PRINT: return isPRINT_LC(character);
+ case _CC_ENUM_PSXSPC: return isPSXSPC_LC(character);
+ case _CC_ENUM_PUNCT: return isPUNCT_LC(character);
+ case _CC_ENUM_SPACE: return isSPACE_LC(character);
+ case _CC_ENUM_UPPER: return isUPPER_LC(character);
+ case _CC_ENUM_WORDCHAR: return isWORDCHAR_LC(character);
+ case _CC_ENUM_XDIGIT: return isXDIGIT_LC(character);
+ default: /* VERTSPACE should never occur in locales */
+ Perl_croak(aTHX_ "panic: isFOO_lc() has an unexpected character class '%d'", classnum);
+ }
+
+ assert(0); /* NOTREACHED */
+ return FALSE;
+}
+
+STATIC bool
+S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character)
+{
+ /* Returns a boolean as to whether or not the (well-formed) UTF-8-encoded
+ * 'character' is a member of the Posix character class given by 'classnum'
+ * that should be equivalent to a value in the typedef
+ * '_char_class_number'.
+ *
+ * This just calls isFOO_lc on the code point for the character if it is in
+ * the range 0-255. Outside that range, all characters avoid Unicode
+ * rules, ignoring any locale. So use the Unicode function if this class
+ * requires a swash, and use the Unicode macro otherwise. */
+
+ PERL_ARGS_ASSERT_ISFOO_UTF8_LC;
+
+ if (UTF8_IS_INVARIANT(*character)) {
+ return isFOO_lc(classnum, *character);
+ }
+ else if (UTF8_IS_DOWNGRADEABLE_START(*character)) {
+ return isFOO_lc(classnum,
+ TWO_BYTE_UTF8_TO_UNI(*character, *(character + 1)));
+ }
+
+ if (classnum < _FIRST_NON_SWASH_CC) {
+
+ /* Initialize the swash unless done already */
+ if (! PL_utf8_swash_ptrs[classnum]) {
+ U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
+ PL_utf8_swash_ptrs[classnum] = _core_swash_init("utf8",
+ swash_property_names[classnum], &PL_sv_undef, 1, 0, NULL, &flags);
+ }
+
+ return cBOOL(swash_fetch(PL_utf8_swash_ptrs[classnum], (U8 *)
+ character,
+ TRUE /* is UTF */ ));
+ }
+
+ switch ((_char_class_number) classnum) {
+ case _CC_ENUM_SPACE:
+ case _CC_ENUM_PSXSPC: return is_XPERLSPACE_high(character);
+
+ case _CC_ENUM_BLANK: return is_HORIZWS_high(character);
+ case _CC_ENUM_XDIGIT: return is_XDIGIT_high(character);
+ case _CC_ENUM_VERTSPACE: return is_VERTWS_high(character);
+ default: return 0; /* Things like CNTRL are always
+ below 256 */
+ }
+
+ assert(0); /* NOTREACHED */
+ return FALSE;
+}
+
/*
* pregexec and friends
*/
- pregexec - match a regexp against a string
*/
I32
-Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend,
+Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
char *strbeg, I32 minend, SV *screamer, U32 nosave)
/* stringarg: the point in the string at which to begin matching */
/* strend: pointer to null at end of string */
/* A failure to find a constant substring means that there is no need to make
an expensive call to REx engine, thus we celebrate a failure. Similarly,
- finding a substring too deep into the string means that less calls to
+ finding a substring too deep into the string means that fewer calls to
regtry() should be needed.
REx compiler's optimizer found 4 possible hints:
The nodes of the REx which we used for the search should have been
deleted from the finite automaton. */
+/* args:
+ * rx: the regex to match against
+ * sv: the SV being matched: only used for utf8 flag; the string
+ * itself is accessed via the pointers below. Note that on
+ * something like an overloaded SV, SvPOK(sv) may be false
+ * and the string pointers may point to something unrelated to
+ * the SV itself.
+ * strbeg: real beginning of string
+ * strpos: the point in the string at which to begin matching
+ * strend: pointer to the byte following the last char of the string
+ * flags currently unused; set to 0
+ * data: currently unused; set to NULL
+ */
+
char *
-Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
- char *strend, const U32 flags, re_scream_pos_data *data)
+Perl_re_intuit_start(pTHX_
+ REGEXP * const rx,
+ SV *sv,
+ const char * const strbeg,
+ char *strpos,
+ char *strend,
+ const U32 flags,
+ re_scream_pos_data *data)
{
dVAR;
- struct regexp *const prog = (struct regexp *)SvANY(rx);
+ struct regexp *const prog = ReANY(rx);
I32 start_shift = 0;
/* Should be nonnegative! */
I32 end_shift = 0;
char *s;
SV *check;
- char *strbeg;
char *t;
const bool utf8_target = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
I32 ml_anch;
char *checked_upto = NULL; /* how far into the string we have already checked using find_byclass*/
const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
RXi_GET_DECL(prog,progi);
+ regmatch_info reginfo_buf; /* create some info to pass to find_byclass */
+ regmatch_info *const reginfo = ®info_buf;
#ifdef DEBUGGING
const char * const i_strpos = strpos;
#endif
PERL_UNUSED_ARG(flags);
PERL_UNUSED_ARG(data);
- RX_MATCH_UTF8_set(rx,utf8_target);
-
- if (RX_UTF8(rx)) {
- PL_reg_flags |= RF_utf8;
- }
- DEBUG_EXECUTE_r(
- debug_start_match(rx, utf8_target, strpos, strend,
- sv ? "Guessing start of match in sv for"
- : "Guessing start of match in string for");
- );
-
/* CHR_DIST() would be more correct here but it makes things slow. */
if (prog->minlen > strend - strpos) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
"String too short... [re_intuit_start]\n"));
goto fail;
}
-
- /* XXX we need to pass strbeg as a separate arg: the following is
- * guesswork and can be wrong... */
- if (sv && SvPOK(sv)) {
- char * p = SvPVX(sv);
- STRLEN cur = SvCUR(sv);
- if (p <= strpos && strpos < p + cur) {
- strbeg = p;
- assert(p <= strend && strend <= p + cur);
- }
- else
- strbeg = strend - cur;
- }
- else
- strbeg = strpos;
- PL_regeol = strend;
+ reginfo->is_utf8_target = cBOOL(utf8_target);
+ reginfo->info_aux = NULL;
+ reginfo->strbeg = strbeg;
+ reginfo->strend = strend;
+ reginfo->is_utf8_pat = cBOOL(RX_UTF8(rx));
+ reginfo->intuit = 1;
+ /* not actually used within intuit, but zero for safety anyway */
+ reginfo->poscache_maxiter = 0;
+
if (utf8_target) {
if (!prog->check_utf8 && prog->check_substr)
to_utf8_substr(prog);
} else {
if (!prog->check_substr && prog->check_utf8) {
if (! to_byte_substr(prog)) {
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- non_utf8_target_but_utf8_required));
- goto fail;
+ NON_UTF8_TARGET_BUT_UTF8_REQUIRED(fail);
}
}
check = prog->check_substr;
if (!ml_anch) {
if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
&& !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
- /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
- && sv && !SvROK(sv)
&& (strpos != strbeg)) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
goto fail;
}
- if (prog->check_offset_min == prog->check_offset_max &&
- !(prog->extflags & RXf_CANY_SEEN)) {
+ if (prog->check_offset_min == prog->check_offset_max
+ && !(prog->extflags & RXf_CANY_SEEN)
+ && ! multiline) /* /m can cause \n's to match that aren't
+ accounted for in the string max length.
+ See [perl #115242] */
+ {
/* Substring at constant offset from beg-of-str... */
I32 slen;
try_at_start:
/* Even in this situation we may use MBOL flag if strpos is offset
wrt the start of the string. */
- if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
- && (strpos != strbeg) && strpos[-1] != '\n'
+ if (ml_anch && (strpos != strbeg) && strpos[-1] != '\n'
/* May be due to an implicit anchor of m{.*foo} */
&& !(prog->intflags & PREGf_IMPLICIT))
{
(IV)start_shift, (IV)(check_at - strbeg), (IV)(s - strbeg), (IV)(endpos - strbeg), (IV)(checked_upto- strbeg)));
t = s;
- s = find_byclass(prog, progi->regstclass, checked_upto, endpos, NULL);
+ s = find_byclass(prog, progi->regstclass, checked_upto, endpos,
+ reginfo);
if (s) {
checked_upto = s;
} else {
? (utf8_target ? trie_utf8 : trie_plain) \
: (utf8_target ? trie_utf8_fold : trie_latin_utf8_fold))
-#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, \
-uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \
+#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \
+STMT_START { \
STRLEN skiplen; \
switch (trie_type) { \
case trie_utf8_fold: \
len=0; \
} else { \
len = 1; \
- uvc = _to_fold_latin1( (U8) *uc, foldbuf, &foldlen, 1); \
+ uvc = _to_fold_latin1( (U8) *uc, foldbuf, &foldlen, FOLD_FLAGS_FULL); \
skiplen = UNISKIP( uvc ); \
foldlen -= skiplen; \
uscan = foldbuf + skiplen; \
while (s <= e) { \
if ( (CoNd) \
&& (ln == 1 || folder(s, pat_string, ln)) \
- && (!reginfo || regtry(reginfo, &s)) ) \
+ && (reginfo->intuit || regtry(reginfo, &s)) )\
goto got_it; \
s++; \
} \
#define REXEC_FBC_UTF8_SCAN(CoDe) \
STMT_START { \
- while (s < strend && s + (uskip = UTF8SKIP(s)) <= strend) { \
+ while (s < strend) { \
CoDe \
- s += uskip; \
+ s += UTF8SKIP(s); \
} \
} STMT_END
#define REXEC_FBC_UTF8_CLASS_SCAN(CoNd) \
REXEC_FBC_UTF8_SCAN( \
if (CoNd) { \
- if (tmp && (!reginfo || regtry(reginfo, &s))) \
+ if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
goto got_it; \
else \
tmp = doevery; \
#define REXEC_FBC_CLASS_SCAN(CoNd) \
REXEC_FBC_SCAN( \
if (CoNd) { \
- if (tmp && (!reginfo || regtry(reginfo, &s))) \
+ if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \
goto got_it; \
else \
tmp = doevery; \
)
#define REXEC_FBC_TRYIT \
-if ((!reginfo || regtry(reginfo, &s))) \
+if ((reginfo->intuit || regtry(reginfo, &s))) \
goto got_it
#define REXEC_FBC_CSCAN(CoNdUtF8,CoNd) \
REXEC_FBC_CLASS_SCAN(CoNd); \
}
-#define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd) \
- if (utf8_target) { \
- UtFpReLoAd; \
- REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \
- } \
- else { \
- REXEC_FBC_CLASS_SCAN(CoNd); \
- }
-
-#define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd) \
- PL_reg_flags |= RF_tainted; \
- if (utf8_target) { \
- REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \
- } \
- else { \
- REXEC_FBC_CLASS_SCAN(CoNd); \
- }
-
#define DUMP_EXEC_POS(li,s,doutf8) \
- dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
+ dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \
+ startpos, doutf8)
#define UTF8_NOLOAD(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
- tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n'; \
+ tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \
tmp = TEST_NON_UTF8(tmp); \
REXEC_FBC_UTF8_SCAN( \
if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
); \
#define UTF8_LOAD(TeSt1_UtF8, TeSt2_UtF8, IF_SUCCESS, IF_FAIL) \
- if (s == PL_bostr) { \
+ if (s == reginfo->strbeg) { \
tmp = '\n'; \
} \
else { \
- U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr); \
+ U8 * const r = reghop3((U8*)s, -1, (U8*)reginfo->strbeg); \
tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT); \
} \
tmp = TeSt1_UtF8; \
UTF8_CODE \
} \
else { /* Not utf8 */ \
- tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n'; \
+ tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \
tmp = TEST_NON_UTF8(tmp); \
REXEC_FBC_SCAN( \
if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
} \
); \
} \
- if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, &s))) \
+ if ((!prog->minlen && tmp) && (reginfo->intuit || regtry(reginfo, &s))) \
goto got_it;
/* We know what class REx starts with. Try to find this position... */
-/* if reginfo is NULL, its a dryrun */
+/* if reginfo->intuit, its a dryrun */
/* annoyingly all the vars in this routine have different names from their counterparts
in regmatch. /grrr */
S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
const char *strend, regmatch_info *reginfo)
{
- dVAR;
- const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
- char *pat_string; /* The pattern's exactish string */
- char *pat_end; /* ptr to end char of pat_string */
- re_fold_t folder; /* Function for computing non-utf8 folds */
- const U8 *fold_array; /* array for folding ords < 256 */
- STRLEN ln;
- STRLEN lnc;
- STRLEN uskip;
- U8 c1;
- U8 c2;
- char *e;
- I32 tmp = 1; /* Scratch variable? */
- const bool utf8_target = PL_reg_match_utf8;
- UV utf8_fold_flags = 0;
- RXi_GET_DECL(prog,progi);
-
- PERL_ARGS_ASSERT_FIND_BYCLASS;
-
- /* We know what class it must start with. */
- switch (OP(c)) {
- case ANYOFV:
- case ANYOF:
- if (utf8_target || OP(c) == ANYOFV) {
- STRLEN inclasslen = strend - s;
- REXEC_FBC_UTF8_CLASS_SCAN(
- reginclass(prog, c, (U8*)s, &inclasslen, utf8_target));
- }
- else {
- REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s));
- }
- break;
- case CANY:
- REXEC_FBC_SCAN(
- if (tmp && (!reginfo || regtry(reginfo, &s)))
- goto got_it;
- else
- tmp = doevery;
- );
- break;
+ dVAR;
+ const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
+ char *pat_string; /* The pattern's exactish string */
+ char *pat_end; /* ptr to end char of pat_string */
+ re_fold_t folder; /* Function for computing non-utf8 folds */
+ const U8 *fold_array; /* array for folding ords < 256 */
+ STRLEN ln;
+ STRLEN lnc;
+ U8 c1;
+ U8 c2;
+ char *e;
+ I32 tmp = 1; /* Scratch variable? */
+ const bool utf8_target = reginfo->is_utf8_target;
+ UV utf8_fold_flags = 0;
+ const bool is_utf8_pat = reginfo->is_utf8_pat;
+ bool to_complement = FALSE; /* Invert the result? Taking the xor of this
+ with a result inverts that result, as 0^1 =
+ 1 and 1^1 = 0 */
+ _char_class_number classnum;
- case EXACTFA:
- if (UTF_PATTERN || utf8_target) {
- utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
- goto do_exactf_utf8;
- }
- fold_array = PL_fold_latin1; /* Latin1 folds are not affected by */
- folder = foldEQ_latin1; /* /a, except the sharp s one which */
- goto do_exactf_non_utf8; /* isn't dealt with by these */
+ RXi_GET_DECL(prog,progi);
- case EXACTF:
- if (utf8_target) {
+ PERL_ARGS_ASSERT_FIND_BYCLASS;
- /* regcomp.c already folded this if pattern is in UTF-8 */
- utf8_fold_flags = 0;
- goto do_exactf_utf8;
- }
- fold_array = PL_fold;
- folder = foldEQ;
- goto do_exactf_non_utf8;
+ /* We know what class it must start with. */
+ switch (OP(c)) {
+ case ANYOF:
+ case ANYOF_SYNTHETIC:
+ case ANYOF_WARN_SUPER:
+ if (utf8_target) {
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ reginclass(prog, c, (U8*)s, utf8_target));
+ }
+ else {
+ REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s));
+ }
+ break;
+ case CANY:
+ REXEC_FBC_SCAN(
+ if (tmp && (reginfo->intuit || regtry(reginfo, &s)))
+ goto got_it;
+ else
+ tmp = doevery;
+ );
+ break;
- case EXACTFL:
- if (UTF_PATTERN || utf8_target) {
- utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
- goto do_exactf_utf8;
- }
- fold_array = PL_fold_locale;
- folder = foldEQ_locale;
- goto do_exactf_non_utf8;
+ case EXACTFA:
+ if (is_utf8_pat || utf8_target) {
+ utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
+ goto do_exactf_utf8;
+ }
+ fold_array = PL_fold_latin1; /* Latin1 folds are not affected by */
+ folder = foldEQ_latin1; /* /a, except the sharp s one which */
+ goto do_exactf_non_utf8; /* isn't dealt with by these */
- case EXACTFU_SS:
- if (UTF_PATTERN) {
- utf8_fold_flags = FOLDEQ_S2_ALREADY_FOLDED;
- }
- goto do_exactf_utf8;
+ case EXACTF:
+ if (utf8_target) {
- case EXACTFU_TRICKYFOLD:
- case EXACTFU:
- if (UTF_PATTERN || utf8_target) {
- utf8_fold_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0;
- goto do_exactf_utf8;
- }
+ /* regcomp.c already folded this if pattern is in UTF-8 */
+ utf8_fold_flags = 0;
+ goto do_exactf_utf8;
+ }
+ fold_array = PL_fold;
+ folder = foldEQ;
+ goto do_exactf_non_utf8;
- /* Any 'ss' in the pattern should have been replaced by regcomp,
- * so we don't have to worry here about this single special case
- * in the Latin1 range */
- fold_array = PL_fold_latin1;
- folder = foldEQ_latin1;
+ case EXACTFL:
+ if (is_utf8_pat || utf8_target) {
+ utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
+ goto do_exactf_utf8;
+ }
+ fold_array = PL_fold_locale;
+ folder = foldEQ_locale;
+ goto do_exactf_non_utf8;
- /* FALL THROUGH */
+ case EXACTFU_SS:
+ if (is_utf8_pat) {
+ utf8_fold_flags = FOLDEQ_S2_ALREADY_FOLDED;
+ }
+ goto do_exactf_utf8;
- do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there
- are no glitches with fold-length differences
- between the target string and pattern */
-
- /* The idea in the non-utf8 EXACTF* cases is to first find the
- * first character of the EXACTF* node and then, if necessary,
- * case-insensitively compare the full text of the node. c1 is the
- * first character. c2 is its fold. This logic will not work for
- * Unicode semantics and the german sharp ss, which hence should
- * not be compiled into a node that gets here. */
- pat_string = STRING(c);
- ln = STR_LEN(c); /* length to match in octets/bytes */
-
- /* We know that we have to match at least 'ln' bytes (which is the
- * same as characters, since not utf8). If we have to match 3
- * characters, and there are only 2 availabe, we know without
- * trying that it will fail; so don't start a match past the
- * required minimum number from the far end */
- e = HOP3c(strend, -((I32)ln), s);
-
- if (!reginfo && e < s) {
- e = s; /* Due to minlen logic of intuit() */
- }
+ case EXACTFU_TRICKYFOLD:
+ case EXACTFU:
+ if (is_utf8_pat || utf8_target) {
+ utf8_fold_flags = is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0;
+ goto do_exactf_utf8;
+ }
- c1 = *pat_string;
- c2 = fold_array[c1];
- if (c1 == c2) { /* If char and fold are the same */
- REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
- }
- else {
- REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
- }
- break;
+ /* Any 'ss' in the pattern should have been replaced by regcomp,
+ * so we don't have to worry here about this single special case
+ * in the Latin1 range */
+ fold_array = PL_fold_latin1;
+ folder = foldEQ_latin1;
+
+ /* FALL THROUGH */
+
+ do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there
+ are no glitches with fold-length differences
+ between the target string and pattern */
+
+ /* The idea in the non-utf8 EXACTF* cases is to first find the
+ * first character of the EXACTF* node and then, if necessary,
+ * case-insensitively compare the full text of the node. c1 is the
+ * first character. c2 is its fold. This logic will not work for
+ * Unicode semantics and the german sharp ss, which hence should
+ * not be compiled into a node that gets here. */
+ pat_string = STRING(c);
+ ln = STR_LEN(c); /* length to match in octets/bytes */
+
+ /* We know that we have to match at least 'ln' bytes (which is the
+ * same as characters, since not utf8). If we have to match 3
+ * characters, and there are only 2 availabe, we know without
+ * trying that it will fail; so don't start a match past the
+ * required minimum number from the far end */
+ e = HOP3c(strend, -((I32)ln), s);
+
+ if (reginfo->intuit && e < s) {
+ e = s; /* Due to minlen logic of intuit() */
+ }
- do_exactf_utf8:
- {
- unsigned expansion;
-
-
- /* If one of the operands is in utf8, we can't use the simpler
- * folding above, due to the fact that many different characters
- * can have the same fold, or portion of a fold, or different-
- * length fold */
- pat_string = STRING(c);
- ln = STR_LEN(c); /* length to match in octets/bytes */
- pat_end = pat_string + ln;
- lnc = (UTF_PATTERN) /* length to match in characters */
- ? utf8_length((U8 *) pat_string, (U8 *) pat_end)
- : ln;
-
- /* We have 'lnc' characters to match in the pattern, but because of
- * multi-character folding, each character in the target can match
- * up to 3 characters (Unicode guarantees it will never exceed
- * this) if it is utf8-encoded; and up to 2 if not (based on the
- * fact that the Latin 1 folds are already determined, and the
- * only multi-char fold in that range is the sharp-s folding to
- * 'ss'. Thus, a pattern character can match as little as 1/3 of a
- * string character. Adjust lnc accordingly, rounding up, so that
- * if we need to match at least 4+1/3 chars, that really is 5. */
- expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2;
- lnc = (lnc + expansion - 1) / expansion;
-
- /* As in the non-UTF8 case, if we have to match 3 characters, and
- * only 2 are left, it's guaranteed to fail, so don't start a
- * match that would require us to go beyond the end of the string
- */
- e = HOP3c(strend, -((I32)lnc), s);
+ c1 = *pat_string;
+ c2 = fold_array[c1];
+ if (c1 == c2) { /* If char and fold are the same */
+ REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
+ }
+ else {
+ REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
+ }
+ break;
- if (!reginfo && e < s) {
- e = s; /* Due to minlen logic of intuit() */
- }
+ do_exactf_utf8:
+ {
+ unsigned expansion;
+
+ /* If one of the operands is in utf8, we can't use the simpler folding
+ * above, due to the fact that many different characters can have the
+ * same fold, or portion of a fold, or different- length fold */
+ pat_string = STRING(c);
+ ln = STR_LEN(c); /* length to match in octets/bytes */
+ pat_end = pat_string + ln;
+ lnc = is_utf8_pat /* length to match in characters */
+ ? utf8_length((U8 *) pat_string, (U8 *) pat_end)
+ : ln;
+
+ /* We have 'lnc' characters to match in the pattern, but because of
+ * multi-character folding, each character in the target can match
+ * up to 3 characters (Unicode guarantees it will never exceed
+ * this) if it is utf8-encoded; and up to 2 if not (based on the
+ * fact that the Latin 1 folds are already determined, and the
+ * only multi-char fold in that range is the sharp-s folding to
+ * 'ss'. Thus, a pattern character can match as little as 1/3 of a
+ * string character. Adjust lnc accordingly, rounding up, so that
+ * if we need to match at least 4+1/3 chars, that really is 5. */
+ expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2;
+ lnc = (lnc + expansion - 1) / expansion;
+
+ /* As in the non-UTF8 case, if we have to match 3 characters, and
+ * only 2 are left, it's guaranteed to fail, so don't start a
+ * match that would require us to go beyond the end of the string
+ */
+ e = HOP3c(strend, -((I32)lnc), s);
+
+ if (reginfo->intuit && e < s) {
+ e = s; /* Due to minlen logic of intuit() */
+ }
- /* XXX Note that we could recalculate e to stop the loop earlier,
- * as the worst case expansion above will rarely be met, and as we
- * go along we would usually find that e moves further to the left.
- * This would happen only after we reached the point in the loop
- * where if there were no expansion we should fail. Unclear if
- * worth the expense */
-
- while (s <= e) {
- char *my_strend= (char *)strend;
- if (foldEQ_utf8_flags(s, &my_strend, 0, utf8_target,
- pat_string, NULL, ln, cBOOL(UTF_PATTERN), utf8_fold_flags)
- && (!reginfo || regtry(reginfo, &s)) )
- {
- goto got_it;
- }
- s += (utf8_target) ? UTF8SKIP(s) : 1;
- }
- break;
- }
- case BOUNDL:
- PL_reg_flags |= RF_tainted;
- FBC_BOUND(isALNUM_LC,
- isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp)),
- isALNUM_LC_utf8((U8*)s));
- break;
- case NBOUNDL:
- PL_reg_flags |= RF_tainted;
- FBC_NBOUND(isALNUM_LC,
- isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp)),
- isALNUM_LC_utf8((U8*)s));
- break;
- case BOUND:
- FBC_BOUND(isWORDCHAR,
- isALNUM_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
- break;
- case BOUNDA:
- FBC_BOUND_NOLOAD(isWORDCHAR_A,
- isWORDCHAR_A(tmp),
- isWORDCHAR_A((U8*)s));
- break;
- case NBOUND:
- FBC_NBOUND(isWORDCHAR,
- isALNUM_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
- break;
- case NBOUNDA:
- FBC_NBOUND_NOLOAD(isWORDCHAR_A,
- isWORDCHAR_A(tmp),
- isWORDCHAR_A((U8*)s));
- break;
- case BOUNDU:
- FBC_BOUND(isWORDCHAR_L1,
- isALNUM_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
- break;
- case NBOUNDU:
- FBC_NBOUND(isWORDCHAR_L1,
- isALNUM_uni(tmp),
- cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
- break;
- case ALNUML:
- REXEC_FBC_CSCAN_TAINT(
- isALNUM_LC_utf8((U8*)s),
- isALNUM_LC(*s)
- );
- break;
- case ALNUMU:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_ALNUM(),
- swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
- isWORDCHAR_L1((U8) *s)
- );
- break;
- case ALNUM:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_ALNUM(),
- swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
- isWORDCHAR((U8) *s)
- );
- break;
- case ALNUMA:
- /* Don't need to worry about utf8, as it can match only a single
- * byte invariant character */
- REXEC_FBC_CLASS_SCAN( isWORDCHAR_A(*s));
- break;
- case NALNUMU:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_ALNUM(),
- !swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
- ! isWORDCHAR_L1((U8) *s)
- );
- break;
- case NALNUM:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_ALNUM(),
- !swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target),
- ! isALNUM(*s)
- );
- break;
- case NALNUMA:
- REXEC_FBC_CSCAN(
- !isWORDCHAR_A(*s),
- !isWORDCHAR_A(*s)
- );
- break;
- case NALNUML:
- REXEC_FBC_CSCAN_TAINT(
- !isALNUM_LC_utf8((U8*)s),
- !isALNUM_LC(*s)
- );
- break;
- case SPACEU:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_SPACE(),
- *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target),
- isSPACE_L1((U8) *s)
- );
- break;
- case SPACE:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_SPACE(),
- *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target),
- isSPACE((U8) *s)
- );
- break;
- case SPACEA:
- /* Don't need to worry about utf8, as it can match only a single
- * byte invariant character */
- REXEC_FBC_CLASS_SCAN( isSPACE_A(*s));
- break;
- case SPACEL:
- REXEC_FBC_CSCAN_TAINT(
- isSPACE_LC_utf8((U8*)s),
- isSPACE_LC(*s)
- );
- break;
- case NSPACEU:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_SPACE(),
- !( *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)),
- ! isSPACE_L1((U8) *s)
- );
- break;
- case NSPACE:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_SPACE(),
- !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)),
- ! isSPACE((U8) *s)
- );
- break;
- case NSPACEA:
- REXEC_FBC_CSCAN(
- !isSPACE_A(*s),
- !isSPACE_A(*s)
- );
- break;
- case NSPACEL:
- REXEC_FBC_CSCAN_TAINT(
- !isSPACE_LC_utf8((U8*)s),
- !isSPACE_LC(*s)
- );
- break;
- case DIGIT:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_DIGIT(),
- swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
- isDIGIT(*s)
- );
- break;
- case DIGITA:
- /* Don't need to worry about utf8, as it can match only a single
- * byte invariant character */
- REXEC_FBC_CLASS_SCAN( isDIGIT_A(*s));
- break;
- case DIGITL:
- REXEC_FBC_CSCAN_TAINT(
- isDIGIT_LC_utf8((U8*)s),
- isDIGIT_LC(*s)
- );
- break;
- case NDIGIT:
- REXEC_FBC_CSCAN_PRELOAD(
- LOAD_UTF8_CHARCLASS_DIGIT(),
- !swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
- !isDIGIT(*s)
- );
- break;
- case NDIGITA:
- REXEC_FBC_CSCAN(
- !isDIGIT_A(*s),
- !isDIGIT_A(*s)
- );
- break;
- case NDIGITL:
- REXEC_FBC_CSCAN_TAINT(
- !isDIGIT_LC_utf8((U8*)s),
- !isDIGIT_LC(*s)
- );
- break;
- case LNBREAK:
- REXEC_FBC_CSCAN(
- is_LNBREAK_utf8_safe(s, strend),
- is_LNBREAK_latin1_safe(s, strend)
- );
- break;
- case VERTWS:
- REXEC_FBC_CSCAN(
- is_VERTWS_utf8_safe(s, strend),
- is_VERTWS_latin1_safe(s, strend)
- );
- break;
- case NVERTWS:
- REXEC_FBC_CSCAN(
- !is_VERTWS_utf8_safe(s, strend),
- !is_VERTWS_latin1_safe(s, strend)
- );
- break;
- case HORIZWS:
- REXEC_FBC_CSCAN(
- is_HORIZWS_utf8_safe(s, strend),
- is_HORIZWS_latin1_safe(s, strend)
- );
- break;
- case NHORIZWS:
- REXEC_FBC_CSCAN(
- !is_HORIZWS_utf8_safe(s, strend),
- !is_HORIZWS_latin1_safe(s, strend)
- );
- break;
- case POSIXA:
- /* Don't need to worry about utf8, as it can match only a single
- * byte invariant character. The flag in this node type is the
- * class number to pass to _generic_isCC() to build a mask for
- * searching in PL_charclass[] */
- REXEC_FBC_CLASS_SCAN( _generic_isCC_A(*s, FLAGS(c)));
- break;
- case NPOSIXA:
- REXEC_FBC_CSCAN(
- !_generic_isCC_A(*s, FLAGS(c)),
- !_generic_isCC_A(*s, FLAGS(c))
- );
- break;
+ /* XXX Note that we could recalculate e to stop the loop earlier,
+ * as the worst case expansion above will rarely be met, and as we
+ * go along we would usually find that e moves further to the left.
+ * This would happen only after we reached the point in the loop
+ * where if there were no expansion we should fail. Unclear if
+ * worth the expense */
+
+ while (s <= e) {
+ char *my_strend= (char *)strend;
+ if (foldEQ_utf8_flags(s, &my_strend, 0, utf8_target,
+ pat_string, NULL, ln, is_utf8_pat, utf8_fold_flags)
+ && (reginfo->intuit || regtry(reginfo, &s)) )
+ {
+ goto got_it;
+ }
+ s += (utf8_target) ? UTF8SKIP(s) : 1;
+ }
+ break;
+ }
+ case BOUNDL:
+ RXp_MATCH_TAINTED_on(prog);
+ FBC_BOUND(isWORDCHAR_LC,
+ isWORDCHAR_LC_uvchr(UNI_TO_NATIVE(tmp)),
+ isWORDCHAR_LC_utf8((U8*)s));
+ break;
+ case NBOUNDL:
+ RXp_MATCH_TAINTED_on(prog);
+ FBC_NBOUND(isWORDCHAR_LC,
+ isWORDCHAR_LC_uvchr(UNI_TO_NATIVE(tmp)),
+ isWORDCHAR_LC_utf8((U8*)s));
+ break;
+ case BOUND:
+ FBC_BOUND(isWORDCHAR,
+ isWORDCHAR_uni(tmp),
+ cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ break;
+ case BOUNDA:
+ FBC_BOUND_NOLOAD(isWORDCHAR_A,
+ isWORDCHAR_A(tmp),
+ isWORDCHAR_A((U8*)s));
+ break;
+ case NBOUND:
+ FBC_NBOUND(isWORDCHAR,
+ isWORDCHAR_uni(tmp),
+ cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ break;
+ case NBOUNDA:
+ FBC_NBOUND_NOLOAD(isWORDCHAR_A,
+ isWORDCHAR_A(tmp),
+ isWORDCHAR_A((U8*)s));
+ break;
+ case BOUNDU:
+ FBC_BOUND(isWORDCHAR_L1,
+ isWORDCHAR_uni(tmp),
+ cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ break;
+ case NBOUNDU:
+ FBC_NBOUND(isWORDCHAR_L1,
+ isWORDCHAR_uni(tmp),
+ cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target)));
+ break;
+ case LNBREAK:
+ REXEC_FBC_CSCAN(is_LNBREAK_utf8_safe(s, strend),
+ is_LNBREAK_latin1_safe(s, strend)
+ );
+ break;
- case AHOCORASICKC:
- case AHOCORASICK:
- {
- DECL_TRIE_TYPE(c);
- /* what trie are we using right now */
- reg_ac_data *aho
- = (reg_ac_data*)progi->data->data[ ARG( c ) ];
- reg_trie_data *trie
- = (reg_trie_data*)progi->data->data[ aho->trie ];
- HV *widecharmap = MUTABLE_HV(progi->data->data[ aho->trie + 1 ]);
+ /* The argument to all the POSIX node types is the class number to pass to
+ * _generic_isCC() to build a mask for searching in PL_charclass[] */
- const char *last_start = strend - trie->minlen;
-#ifdef DEBUGGING
- const char *real_start = s;
-#endif
- STRLEN maxlen = trie->maxlen;
- SV *sv_points;
- 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
- is always 1:1, but for Unicode, especially
- case folded Unicode this is not true. */
- U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
- U8 *bitmap=NULL;
-
-
- GET_RE_DEBUG_FLAGS_DECL;
-
- /* We can't just allocate points here. We need to wrap it in
- * an SV so it gets freed properly if there is a croak while
- * running the match */
- ENTER;
- SAVETMPS;
- sv_points=newSV(maxlen * sizeof(U8 *));
- SvCUR_set(sv_points,
- maxlen * sizeof(U8 *));
- SvPOK_on(sv_points);
- sv_2mortal(sv_points);
- points=(U8**)SvPV_nolen(sv_points );
- if ( trie_type != trie_utf8_fold
- && (trie->bitmap || OP(c)==AHOCORASICKC) )
- {
- if (trie->bitmap)
- bitmap=(U8*)trie->bitmap;
- else
- bitmap=(U8*)ANYOF_BITMAP(c);
- }
- /* 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 with a possible matching char, when
- we encounter an unknown char (and we have not encountered
- an accepting state) we scan forward until we find a legal
- starting char.
- AC matching is basically that of trie matching, except
- that when we encounter a failing transition, we fall back
- to the current states "fail state", and try the current char
- again, a process we repeat until we reach the root state,
- state 1, or a legal transition. If we fail on the root state
- then we can either terminate if we have reached an accepting
- state previously, or restart the entire process from the beginning
- if we have not.
+ case NPOSIXL:
+ to_complement = 1;
+ /* FALLTHROUGH */
- */
- while (s <= last_start) {
- const U32 uniflags = UTF8_ALLOW_DEFAULT;
- U8 *uc = (U8*)s;
- U16 charid = 0;
- U32 base = 1;
- U32 state = 1;
- UV uvc = 0;
- STRLEN len = 0;
- STRLEN foldlen = 0;
- U8 *uscan = (U8*)NULL;
- U8 *leftmost = NULL;
-#ifdef DEBUGGING
- U32 accepted_word= 0;
-#endif
- U32 pointpos = 0;
+ case POSIXL:
+ RXp_MATCH_TAINTED_on(prog);
+ REXEC_FBC_CSCAN(to_complement ^ cBOOL(isFOO_utf8_lc(FLAGS(c), (U8 *) s)),
+ to_complement ^ cBOOL(isFOO_lc(FLAGS(c), *s)));
+ break;
- while ( state && uc <= (U8*)strend ) {
- int failed=0;
- U32 word = aho->states[ state ].wordnum;
+ case NPOSIXD:
+ to_complement = 1;
+ /* FALLTHROUGH */
- if( state==1 ) {
- if ( bitmap ) {
- DEBUG_TRIE_EXECUTE_r(
- if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
- dump_exec_pos( (char *)uc, c, strend, real_start,
- (char *)uc, utf8_target );
- PerlIO_printf( Perl_debug_log,
- " Scanning for legal start char...\n");
- }
- );
- if (utf8_target) {
- while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
- uc += UTF8SKIP(uc);
- }
- } else {
- while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
- uc++;
- }
- }
- s= (char *)uc;
- }
- if (uc >(U8*)last_start) break;
- }
-
- if ( word ) {
- U8 *lpos= points[ (pointpos - trie->wordinfo[word].len) % maxlen ];
- if (!leftmost || lpos < leftmost) {
- DEBUG_r(accepted_word=word);
- leftmost= lpos;
- }
- if (base==0) break;
-
- }
- points[pointpos++ % maxlen]= uc;
- if (foldlen || uc < (U8*)strend) {
- REXEC_TRIE_READ_CHAR(trie_type, trie,
- widecharmap, uc,
- uscan, len, uvc, charid, foldlen,
- foldbuf, uniflags);
- DEBUG_TRIE_EXECUTE_r({
- dump_exec_pos( (char *)uc, c, strend,
- real_start, s, utf8_target);
- PerlIO_printf(Perl_debug_log,
- " Charid:%3u CP:%4"UVxf" ",
- charid, uvc);
- });
- }
- else {
- len = 0;
- charid = 0;
- }
+ case POSIXD:
+ if (utf8_target) {
+ goto posix_utf8;
+ }
+ goto posixa;
+
+ 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)
+ || ! _generic_isCC_A(*s, FLAGS(c)));
+ break;
+ }
+ to_complement = 1;
+ /* FALLTHROUGH */
- do {
-#ifdef DEBUGGING
- word = aho->states[ state ].wordnum;
-#endif
- base = aho->states[ state ].trans.base;
-
- DEBUG_TRIE_EXECUTE_r({
- if (failed)
- dump_exec_pos( (char *)uc, c, strend, real_start,
- s, utf8_target );
- PerlIO_printf( Perl_debug_log,
- "%sState: %4"UVxf", word=%"UVxf,
- failed ? " Fail transition to " : "",
- (UV)state, (UV)word);
- });
- if ( base ) {
- U32 tmp;
- I32 offset;
- if (charid &&
- ( ((offset = base + charid
- - 1 - trie->uniquecharcount)) >= 0)
- && ((U32)offset < trie->lasttrans)
- && trie->trans[offset].check == state
- && (tmp=trie->trans[offset].next))
- {
- DEBUG_TRIE_EXECUTE_r(
- PerlIO_printf( Perl_debug_log," - legal\n"));
- state = tmp;
- break;
- }
- else {
- DEBUG_TRIE_EXECUTE_r(
- PerlIO_printf( Perl_debug_log," - fail\n"));
- failed = 1;
- state = aho->fail[state];
- }
- }
- else {
- /* we must be accepting here */
- DEBUG_TRIE_EXECUTE_r(
- PerlIO_printf( Perl_debug_log," - accepting\n"));
- failed = 1;
- break;
- }
- } while(state);
- uc += len;
- if (failed) {
- if (leftmost)
- break;
- if (!state) state = 1;
- }
- }
- if ( aho->states[ state ].wordnum ) {
- U8 *lpos = points[ (pointpos - trie->wordinfo[aho->states[ state ].wordnum].len) % maxlen ];
- if (!leftmost || lpos < leftmost) {
- DEBUG_r(accepted_word=aho->states[ state ].wordnum);
- leftmost = lpos;
- }
+ case POSIXA:
+ posixa:
+ /* Don't need to worry about utf8, as it can match only a single
+ * byte invariant character. */
+ REXEC_FBC_CLASS_SCAN(
+ to_complement ^ cBOOL(_generic_isCC_A(*s, FLAGS(c))));
+ break;
+
+ case NPOSIXU:
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case POSIXU:
+ if (! utf8_target) {
+ REXEC_FBC_CLASS_SCAN(to_complement ^ cBOOL(_generic_isCC(*s,
+ FLAGS(c))));
+ }
+ else {
+
+ posix_utf8:
+ classnum = (_char_class_number) FLAGS(c);
+ if (classnum < _FIRST_NON_SWASH_CC) {
+ while (s < strend) {
+
+ /* We avoid loading in the swash as long as possible, but
+ * should we have to, we jump to a separate loop. This
+ * extra 'if' statement is what keeps this code from being
+ * just a call to REXEC_FBC_UTF8_CLASS_SCAN() */
+ if (UTF8_IS_ABOVE_LATIN1(*s)) {
+ goto found_above_latin1;
}
- if (leftmost) {
- s = (char*)leftmost;
- DEBUG_TRIE_EXECUTE_r({
- PerlIO_printf(
- Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
- (UV)accepted_word, (IV)(s - real_start)
- );
- });
- if (!reginfo || regtry(reginfo, &s)) {
- FREETMPS;
- LEAVE;
+ if ((UTF8_IS_INVARIANT(*s)
+ && to_complement ^ cBOOL(_generic_isCC((U8) *s,
+ classnum)))
+ || (UTF8_IS_DOWNGRADEABLE_START(*s)
+ && to_complement ^ cBOOL(
+ _generic_isCC(TWO_BYTE_UTF8_TO_UNI(*s, *(s + 1)),
+ classnum))))
+ {
+ if (tmp && (reginfo->intuit || regtry(reginfo, &s)))
goto got_it;
+ else {
+ tmp = doevery;
}
- s = HOPc(s,1);
- DEBUG_TRIE_EXECUTE_r({
- PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
- });
- } else {
- DEBUG_TRIE_EXECUTE_r(
- PerlIO_printf( Perl_debug_log,"No match.\n"));
- break;
}
+ else {
+ tmp = 1;
+ }
+ s += UTF8SKIP(s);
}
- FREETMPS;
- LEAVE;
- }
- break;
- default:
- Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
- break;
- }
- return 0;
- got_it:
- return s;
+ }
+ else switch (classnum) { /* These classes are implemented as
+ macros */
+ case _CC_ENUM_SPACE: /* XXX would require separate code if we
+ revert the change of \v matching this */
+ /* FALL THROUGH */
+
+ case _CC_ENUM_PSXSPC:
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ to_complement ^ cBOOL(isSPACE_utf8(s)));
+ break;
+
+ case _CC_ENUM_BLANK:
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ to_complement ^ cBOOL(isBLANK_utf8(s)));
+ break;
+
+ case _CC_ENUM_XDIGIT:
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ to_complement ^ cBOOL(isXDIGIT_utf8(s)));
+ break;
+
+ case _CC_ENUM_VERTSPACE:
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ to_complement ^ cBOOL(isVERTWS_utf8(s)));
+ break;
+
+ case _CC_ENUM_CNTRL:
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ to_complement ^ cBOOL(isCNTRL_utf8(s)));
+ break;
+
+ default:
+ Perl_croak(aTHX_ "panic: find_byclass() node %d='%s' has an unexpected character class '%d'", OP(c), PL_reg_name[OP(c)], classnum);
+ assert(0); /* NOTREACHED */
+ }
+ }
+ break;
+
+ found_above_latin1: /* Here we have to load a swash to get the result
+ for the current code point */
+ if (! PL_utf8_swash_ptrs[classnum]) {
+ U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
+ PL_utf8_swash_ptrs[classnum] =
+ _core_swash_init("utf8", swash_property_names[classnum],
+ &PL_sv_undef, 1, 0, NULL, &flags);
+ }
+
+ /* This is a copy of the loop above for swash classes, though using the
+ * FBC macro instead of being expanded out. Since we've loaded the
+ * swash, we don't have to check for that each time through the loop */
+ REXEC_FBC_UTF8_CLASS_SCAN(
+ to_complement ^ cBOOL(_generic_utf8(
+ classnum,
+ s,
+ swash_fetch(PL_utf8_swash_ptrs[classnum],
+ (U8 *) s, TRUE))));
+ break;
+
+ case AHOCORASICKC:
+ case AHOCORASICK:
+ {
+ DECL_TRIE_TYPE(c);
+ /* what trie are we using right now */
+ reg_ac_data *aho = (reg_ac_data*)progi->data->data[ ARG( c ) ];
+ reg_trie_data *trie = (reg_trie_data*)progi->data->data[ aho->trie ];
+ HV *widecharmap = MUTABLE_HV(progi->data->data[ aho->trie + 1 ]);
+
+ const char *last_start = strend - trie->minlen;
+#ifdef DEBUGGING
+ const char *real_start = s;
+#endif
+ STRLEN maxlen = trie->maxlen;
+ SV *sv_points;
+ 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
+ is always 1:1, but for Unicode, especially
+ case folded Unicode this is not true. */
+ U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+ U8 *bitmap=NULL;
+
+
+ GET_RE_DEBUG_FLAGS_DECL;
+
+ /* We can't just allocate points here. We need to wrap it in
+ * an SV so it gets freed properly if there is a croak while
+ * running the match */
+ ENTER;
+ SAVETMPS;
+ sv_points=newSV(maxlen * sizeof(U8 *));
+ SvCUR_set(sv_points,
+ maxlen * sizeof(U8 *));
+ SvPOK_on(sv_points);
+ sv_2mortal(sv_points);
+ points=(U8**)SvPV_nolen(sv_points );
+ if ( trie_type != trie_utf8_fold
+ && (trie->bitmap || OP(c)==AHOCORASICKC) )
+ {
+ if (trie->bitmap)
+ bitmap=(U8*)trie->bitmap;
+ else
+ bitmap=(U8*)ANYOF_BITMAP(c);
+ }
+ /* 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
+ with a possible matching char, when we encounter an unknown char
+ (and we have not encountered an accepting state) we scan forward
+ until we find a legal starting char.
+ AC matching is basically that of trie matching, except that when
+ we encounter a failing transition, we fall back to the current
+ states "fail state", and try the current char again, a process
+ we repeat until we reach the root state, state 1, or a legal
+ transition. If we fail on the root state then we can either
+ terminate if we have reached an accepting state previously, or
+ restart the entire process from the beginning if we have not.
+
+ */
+ while (s <= last_start) {
+ const U32 uniflags = UTF8_ALLOW_DEFAULT;
+ U8 *uc = (U8*)s;
+ U16 charid = 0;
+ U32 base = 1;
+ U32 state = 1;
+ UV uvc = 0;
+ STRLEN len = 0;
+ STRLEN foldlen = 0;
+ U8 *uscan = (U8*)NULL;
+ U8 *leftmost = NULL;
+#ifdef DEBUGGING
+ U32 accepted_word= 0;
+#endif
+ U32 pointpos = 0;
+
+ while ( state && uc <= (U8*)strend ) {
+ int failed=0;
+ U32 word = aho->states[ state ].wordnum;
+
+ if( state==1 ) {
+ if ( bitmap ) {
+ DEBUG_TRIE_EXECUTE_r(
+ if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ dump_exec_pos( (char *)uc, c, strend, real_start,
+ (char *)uc, utf8_target );
+ PerlIO_printf( Perl_debug_log,
+ " Scanning for legal start char...\n");
+ }
+ );
+ if (utf8_target) {
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc += UTF8SKIP(uc);
+ }
+ } else {
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc++;
+ }
+ }
+ s= (char *)uc;
+ }
+ if (uc >(U8*)last_start) break;
+ }
+
+ if ( word ) {
+ U8 *lpos= points[ (pointpos - trie->wordinfo[word].len) % maxlen ];
+ if (!leftmost || lpos < leftmost) {
+ DEBUG_r(accepted_word=word);
+ leftmost= lpos;
+ }
+ if (base==0) break;
+
+ }
+ points[pointpos++ % maxlen]= uc;
+ if (foldlen || uc < (U8*)strend) {
+ REXEC_TRIE_READ_CHAR(trie_type, trie,
+ widecharmap, uc,
+ uscan, len, uvc, charid, foldlen,
+ foldbuf, uniflags);
+ DEBUG_TRIE_EXECUTE_r({
+ dump_exec_pos( (char *)uc, c, strend,
+ real_start, s, utf8_target);
+ PerlIO_printf(Perl_debug_log,
+ " Charid:%3u CP:%4"UVxf" ",
+ charid, uvc);
+ });
+ }
+ else {
+ len = 0;
+ charid = 0;
+ }
+
+
+ do {
+#ifdef DEBUGGING
+ word = aho->states[ state ].wordnum;
+#endif
+ base = aho->states[ state ].trans.base;
+
+ DEBUG_TRIE_EXECUTE_r({
+ if (failed)
+ dump_exec_pos( (char *)uc, c, strend, real_start,
+ s, utf8_target );
+ PerlIO_printf( Perl_debug_log,
+ "%sState: %4"UVxf", word=%"UVxf,
+ failed ? " Fail transition to " : "",
+ (UV)state, (UV)word);
+ });
+ if ( base ) {
+ U32 tmp;
+ I32 offset;
+ if (charid &&
+ ( ((offset = base + charid
+ - 1 - trie->uniquecharcount)) >= 0)
+ && ((U32)offset < trie->lasttrans)
+ && trie->trans[offset].check == state
+ && (tmp=trie->trans[offset].next))
+ {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log," - legal\n"));
+ state = tmp;
+ break;
+ }
+ else {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log," - fail\n"));
+ failed = 1;
+ state = aho->fail[state];
+ }
+ }
+ else {
+ /* we must be accepting here */
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log," - accepting\n"));
+ failed = 1;
+ break;
+ }
+ } while(state);
+ uc += len;
+ if (failed) {
+ if (leftmost)
+ break;
+ if (!state) state = 1;
+ }
+ }
+ if ( aho->states[ state ].wordnum ) {
+ U8 *lpos = points[ (pointpos - trie->wordinfo[aho->states[ state ].wordnum].len) % maxlen ];
+ if (!leftmost || lpos < leftmost) {
+ DEBUG_r(accepted_word=aho->states[ state ].wordnum);
+ leftmost = lpos;
+ }
+ }
+ if (leftmost) {
+ s = (char*)leftmost;
+ DEBUG_TRIE_EXECUTE_r({
+ PerlIO_printf(
+ Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
+ (UV)accepted_word, (IV)(s - real_start)
+ );
+ });
+ if (reginfo->intuit || regtry(reginfo, &s)) {
+ FREETMPS;
+ LEAVE;
+ goto got_it;
+ }
+ s = HOPc(s,1);
+ DEBUG_TRIE_EXECUTE_r({
+ PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
+ });
+ } else {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log,"No match.\n"));
+ break;
+ }
+ }
+ FREETMPS;
+ LEAVE;
+ }
+ break;
+ default:
+ Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
+ break;
+ }
+ return 0;
+ got_it:
+ return s;
}
- regexec_flags - match a regexp against a string
*/
I32
-Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend,
+Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
/* stringarg: the point in the string at which to begin matching */
/* strend: pointer to null at end of string */
{
dVAR;
- struct regexp *const prog = (struct regexp *)SvANY(rx);
- /*register*/ char *s;
+ struct regexp *const prog = ReANY(rx);
+ char *s;
regnode *c;
- /*register*/ char *startpos = stringarg;
+ char *startpos = stringarg;
I32 minlen; /* must match at least this many chars */
I32 dontbother = 0; /* how many characters not to try at end */
I32 end_shift = 0; /* Same for the end. */ /* CC */
const bool utf8_target = cBOOL(DO_UTF8(sv));
I32 multiline;
RXi_GET_DECL(prog,progi);
- regmatch_info reginfo; /* create some info to pass to regtry etc */
+ regmatch_info reginfo_buf; /* create some info to pass to regtry etc */
+ regmatch_info *const reginfo = ®info_buf;
regexp_paren_pair *swap = NULL;
+ I32 oldsave;
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_REGEXEC_FLAGS;
return 0;
}
- multiline = prog->extflags & RXf_PMf_MULTILINE;
- reginfo.prog = rx; /* Yes, sorry that this is confusing. */
-
- RX_MATCH_UTF8_set(rx, utf8_target);
- DEBUG_EXECUTE_r(
+ DEBUG_EXECUTE_r(
debug_start_match(rx, utf8_target, startpos, strend,
"Matching");
);
+
+ /* at the end of this function, we'll do a LEAVE_SCOPE(oldsave),
+ * which will call destuctors to reset PL_regmatch_state, free higher
+ * PL_regmatch_slabs, and clean up regmatch_info_aux and
+ * regmatch_info_aux_eval */
+
+ oldsave = PL_savestack_ix;
+
+ multiline = prog->extflags & RXf_PMf_MULTILINE;
minlen = prog->minlen;
if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
"String too short [regexec_flags]...\n"));
goto phooey;
}
-
/* Check validity of program. */
if (UCHARAT(progi->program) != REG_MAGIC) {
Perl_croak(aTHX_ "corrupted regexp program");
}
- PL_reg_flags = 0;
- PL_reg_state.re_state_eval_setup_done = FALSE;
- PL_reg_maxiter = 0;
+ RX_MATCH_TAINTED_off(rx);
+
+ reginfo->prog = rx; /* Yes, sorry that this is confusing. */
+ reginfo->intuit = 0;
+ reginfo->is_utf8_target = cBOOL(utf8_target);
+ reginfo->is_utf8_pat = cBOOL(RX_UTF8(rx));
+ reginfo->warned = FALSE;
+ reginfo->strbeg = strbeg;
+ reginfo->sv = sv;
+ reginfo->poscache_maxiter = 0; /* not yet started a countdown */
+ reginfo->strend = strend;
+ /* see how far we have to get to not match where we matched before */
+ reginfo->till = startpos+minend;
+
+ /* reserve next 2 or 3 slots in PL_regmatch_state:
+ * slot N+0: may currently be in use: skip it
+ * slot N+1: use for regmatch_info_aux struct
+ * slot N+2: use for regmatch_info_aux_eval struct if we have (?{})'s
+ * slot N+3: ready for use by regmatch()
+ */
+
+ {
+ regmatch_state *old_regmatch_state;
+ regmatch_slab *old_regmatch_slab;
+ int i, max = (prog->extflags & RXf_EVAL_SEEN) ? 2 : 1;
+
+ /* on first ever match, allocate first slab */
+ if (!PL_regmatch_slab) {
+ Newx(PL_regmatch_slab, 1, regmatch_slab);
+ PL_regmatch_slab->prev = NULL;
+ PL_regmatch_slab->next = NULL;
+ PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
+ }
- if (RX_UTF8(rx))
- PL_reg_flags |= RF_utf8;
+ old_regmatch_state = PL_regmatch_state;
+ old_regmatch_slab = PL_regmatch_slab;
- /* Mark beginning of line for ^ and lookbehind. */
- reginfo.bol = startpos; /* XXX not used ??? */
- PL_bostr = strbeg;
- reginfo.sv = sv;
+ for (i=0; i <= max; i++) {
+ if (i == 1)
+ reginfo->info_aux = &(PL_regmatch_state->u.info_aux);
+ else if (i ==2)
+ reginfo->info_aux_eval =
+ reginfo->info_aux->info_aux_eval =
+ &(PL_regmatch_state->u.info_aux_eval);
- /* Mark end of line for $ (and such) */
- PL_regeol = strend;
+ if (++PL_regmatch_state > SLAB_LAST(PL_regmatch_slab))
+ PL_regmatch_state = S_push_slab(aTHX);
+ }
- /* see how far we have to get to not match where we matched before */
- reginfo.till = startpos+minend;
+ /* note initial PL_regmatch_state position; at end of match we'll
+ * pop back to there and free any higher slabs */
+
+ reginfo->info_aux->old_regmatch_state = old_regmatch_state;
+ reginfo->info_aux->old_regmatch_slab = old_regmatch_slab;
+ reginfo->info_aux->poscache = NULL;
+
+ SAVEDESTRUCTOR_X(S_cleanup_regmatch_info_aux, reginfo->info_aux);
+
+ if ((prog->extflags & RXf_EVAL_SEEN))
+ S_setup_eval_state(aTHX_ reginfo);
+ else
+ reginfo->info_aux_eval = reginfo->info_aux->info_aux_eval = NULL;
+ }
/* If there is a "must appear" string, look for it. */
s = startpos;
if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
MAGIC *mg;
if (flags & REXEC_IGNOREPOS){ /* Means: check only at start */
- reginfo.ganch = startpos + prog->gofs;
+ reginfo->ganch = startpos + prog->gofs;
DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS IGNOREPOS: reginfo.ganch = startpos + %"UVxf"\n",(UV)prog->gofs));
+ "GPOS IGNOREPOS: reginfo->ganch = startpos + %"UVxf"\n",(UV)prog->gofs));
} else if (sv && SvTYPE(sv) >= SVt_PVMG
&& SvMAGIC(sv)
&& (mg = mg_find(sv, PERL_MAGIC_regex_global))
&& mg->mg_len >= 0) {
- reginfo.ganch = strbeg + mg->mg_len; /* Defined pos() */
+ reginfo->ganch = strbeg + mg->mg_len; /* Defined pos() */
DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS MAGIC: reginfo.ganch = strbeg + %"IVdf"\n",(IV)mg->mg_len));
+ "GPOS MAGIC: reginfo->ganch = strbeg + %"IVdf"\n",(IV)mg->mg_len));
if (prog->extflags & RXf_ANCH_GPOS) {
- if (s > reginfo.ganch)
+ if (s > reginfo->ganch)
goto phooey;
- s = reginfo.ganch - prog->gofs;
+ s = reginfo->ganch - prog->gofs;
DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
"GPOS ANCH_GPOS: s = ganch - %"UVxf"\n",(UV)prog->gofs));
if (s < strbeg)
}
}
else if (data) {
- reginfo.ganch = strbeg + PTR2UV(data);
+ reginfo->ganch = strbeg + PTR2UV(data);
DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS DATA: reginfo.ganch= strbeg + %"UVxf"\n",PTR2UV(data)));
+ "GPOS DATA: reginfo->ganch= strbeg + %"UVxf"\n",PTR2UV(data)));
} else { /* pos() not defined */
- reginfo.ganch = strbeg;
+ reginfo->ganch = strbeg;
DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS: reginfo.ganch = strbeg\n"));
+ "GPOS: reginfo->ganch = strbeg\n"));
}
}
if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
was from this regex we don't want a subsequent partially
successful match to clobber the old results.
So when we detect this possibility we add a swap buffer
- to the re, and switch the buffer each match. If we fail
- we switch it back, otherwise we leave it swapped.
+ to the re, and switch the buffer each match. If we fail,
+ we switch it back; otherwise we leave it swapped.
*/
swap = prog->offs;
/* do we need a save destructor here for eval dies? */
d.scream_olds = &scream_olds;
d.scream_pos = &scream_pos;
- s = re_intuit_start(rx, sv, s, strend, flags, &d);
+ s = re_intuit_start(rx, sv, strbeg, s, strend, flags, &d);
if (!s) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
goto phooey; /* not present */
/* Simplest case: anchored match need be tried only once. */
/* [unless only anchor is BOL and multiline is set] */
if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
- if (s == startpos && regtry(®info, &startpos))
+ if (s == startpos && regtry(reginfo, &startpos))
goto got_it;
else if (multiline || (prog->intflags & PREGf_IMPLICIT)
|| (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
if (s == startpos)
goto after_try_utf8;
while (1) {
- if (regtry(®info, &s)) {
+ if (regtry(reginfo, &s)) {
goto got_it;
}
after_try_utf8:
goto phooey;
}
if (prog->extflags & RXf_USE_INTUIT) {
- s = re_intuit_start(rx, sv, s + UTF8SKIP(s), strend, flags, NULL);
+ s = re_intuit_start(rx, sv, strbeg,
+ s + UTF8SKIP(s), strend, flags, NULL);
if (!s) {
goto phooey;
}
goto after_try_latin;
}
while (1) {
- if (regtry(®info, &s)) {
+ if (regtry(reginfo, &s)) {
goto got_it;
}
after_try_latin:
goto phooey;
}
if (prog->extflags & RXf_USE_INTUIT) {
- s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
+ s = re_intuit_start(rx, sv, strbeg,
+ s + 1, strend, flags, NULL);
if (!s) {
goto phooey;
}
/* We can use a more efficient search as newlines are the same in unicode as they are in latin */
while (s <= end) { /* note it could be possible to match at the end of the string */
if (*s++ == '\n') { /* don't need PL_utf8skip here */
- if (regtry(®info, &s))
+ if (regtry(reginfo, &s))
goto got_it;
}
}
goto phooey;
} else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK))
{
- /* the warning about reginfo.ganch being used without initialization
+ /* the warning about reginfo->ganch being used without initialization
is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
and we only enter this block when the same bit is set. */
- char *tmp_s = reginfo.ganch - prog->gofs;
+ char *tmp_s = reginfo->ganch - prog->gofs;
- if (tmp_s >= strbeg && regtry(®info, &tmp_s))
+ if (tmp_s >= strbeg && regtry(reginfo, &tmp_s))
goto got_it;
goto phooey;
}
/* Messy cases: unanchored match. */
if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
/* we have /x+whatever/ */
- /* it must be a one character string (XXXX Except UTF_PATTERN?) */
+ /* it must be a one character string (XXXX Except is_utf8_pat?) */
char ch;
#ifdef DEBUGGING
int did_match = 0;
REXEC_FBC_SCAN(
if (*s == ch) {
DEBUG_EXECUTE_r( did_match = 1 );
- if (regtry(®info, &s)) goto got_it;
+ if (regtry(reginfo, &s)) goto got_it;
s += UTF8SKIP(s);
while (s < strend && *s == ch)
s += UTF8SKIP(s);
else {
if (! prog->anchored_substr) {
if (! to_byte_substr(prog)) {
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- non_utf8_target_but_utf8_required));
- goto phooey;
+ NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
}
}
ch = SvPVX_const(prog->anchored_substr)[0];
REXEC_FBC_SCAN(
if (*s == ch) {
DEBUG_EXECUTE_r( did_match = 1 );
- if (regtry(®info, &s)) goto got_it;
+ if (regtry(reginfo, &s)) goto got_it;
s++;
while (s < strend && *s == ch)
s++;
else {
if (! prog->anchored_substr) {
if (! to_byte_substr(prog)) {
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- non_utf8_target_but_utf8_required));
- goto phooey;
+ NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
}
}
must = prog->anchored_substr;
else {
if (! prog->float_substr) {
if (! to_byte_substr(prog)) {
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- non_utf8_target_but_utf8_required));
- goto phooey;
+ NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
}
}
must = prog->float_substr;
-(I32)(CHR_SVLEN(must)
- (SvTAIL(must) != 0) + back_min), strbeg);
}
- if (s > PL_bostr)
+ if (s > reginfo->strbeg)
last1 = HOPc(s, -1);
else
last1 = s - 1; /* bogus */
s = HOPc(s, -back_max);
}
else {
- char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
+ char * const t = (last1 >= reginfo->strbeg)
+ ? HOPc(last1, 1) : last1 + 1;
last1 = HOPc(s, -back_min);
s = t;
}
if (utf8_target) {
while (s <= last1) {
- if (regtry(®info, &s))
+ if (regtry(reginfo, &s))
goto got_it;
if (s >= last1) {
s++; /* to break out of outer loop */
}
else {
while (s <= last1) {
- if (regtry(®info, &s))
+ if (regtry(reginfo, &s))
goto got_it;
s++;
}
quoted, (int)(strend - s));
}
});
- if (find_byclass(prog, c, s, strend, ®info))
+ if (find_byclass(prog, c, s, strend, reginfo))
goto got_it;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
}
else {
if (! prog->float_substr) {
if (! to_byte_substr(prog)) {
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- non_utf8_target_but_utf8_required));
- goto phooey;
+ NON_UTF8_TARGET_BUT_UTF8_REQUIRED(phooey);
}
}
float_real = prog->float_substr;
/* We don't know much -- general case. */
if (utf8_target) {
for (;;) {
- if (regtry(®info, &s))
+ if (regtry(reginfo, &s))
goto got_it;
if (s >= strend)
break;
}
else {
do {
- if (regtry(®info, &s))
+ if (regtry(reginfo, &s))
goto got_it;
} while (s++ < strend);
}
);
);
Safefree(swap);
- RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
- if (PL_reg_state.re_state_eval_setup_done)
- restore_pos(aTHX_ prog);
+ /* clean up; this will trigger destructors that will free all slabs
+ * above the current one, and cleanup the regmatch_info_aux
+ * and regmatch_info_aux_eval sructs */
+
+ LEAVE_SCOPE(oldsave);
+
if (RXp_PAREN_NAMES(prog))
(void)hv_iterinit(RXp_PAREN_NAMES(prog));
+ RX_MATCH_UTF8_set(rx, utf8_target);
+
/* make sure $`, $&, $', and $digit will work later */
if ( !(flags & REXEC_NOT_FIRST) ) {
if (flags & REXEC_COPY_STR) {
-#ifdef PERL_OLD_COPY_ON_WRITE
- if ((SvIsCOW(sv)
- || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
+#ifdef PERL_ANY_COW
+ if (SvCANCOW(sv)) {
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
"Copy on write: regexp capture, type %d\n",
prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
assert (SvPOKp(prog->saved_copy));
- prog->sublen = PL_regeol - strbeg;
+ prog->sublen = reginfo->strend - strbeg;
prog->suboffset = 0;
prog->subcoffset = 0;
} else
#endif
{
I32 min = 0;
- I32 max = PL_regeol - strbeg;
+ I32 max = reginfo->strend - strbeg;
I32 sublen;
if ( (flags & REXEC_COPY_SKIP_POST)
max = (PL_sawampersand & SAWAMPERSAND_LEFT)
? prog->offs[0].start
: 0;
- assert(max >= 0 && max <= PL_regeol - strbeg);
+ assert(max >= 0 && max <= reginfo->strend - strbeg);
}
if ( (flags & REXEC_COPY_SKIP_PRE)
}
- assert(min >= 0 && min <= max && min <= PL_regeol - strbeg);
+ assert(min >= 0 && min <= max
+ && min <= reginfo->strend - strbeg);
sublen = max - min;
if (RX_MATCH_COPIED(rx)) {
prog->subbeg = strbeg;
prog->suboffset = 0;
prog->subcoffset = 0;
- prog->sublen = PL_regeol - strbeg; /* strend may have been modified */
+ /* use reginfo->strend, as strend may have been modified */
+ prog->sublen = reginfo->strend - strbeg;
}
}
phooey:
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
PL_colors[4], PL_colors[5]));
- if (PL_reg_state.re_state_eval_setup_done)
- restore_pos(aTHX_ prog);
+
+ /* clean up; this will trigger destructors that will free all slabs
+ * above the current one, and cleanup the regmatch_info_aux
+ * and regmatch_info_aux_eval sructs */
+
+ LEAVE_SCOPE(oldsave);
+
if (swap) {
/* we failed :-( roll it back */
DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
}
-/* Set which rex is pointed to by PL_reg_state, handling ref counting.
+/* Set which rex is pointed to by PL_reg_curpm, handling ref counting.
* Do inc before dec, in case old and new rex are the same */
#define SET_reg_curpm(Re2) \
- if (PL_reg_state.re_state_eval_setup_done) { \
+ if (reginfo->info_aux_eval) { \
(void)ReREFCNT_inc(Re2); \
ReREFCNT_dec(PM_GETRE(PL_reg_curpm)); \
PM_SETRE((PL_reg_curpm), (Re2)); \
dVAR;
CHECKPOINT lastcp;
REGEXP *const rx = reginfo->prog;
- regexp *const prog = (struct regexp *)SvANY(rx);
+ regexp *const prog = ReANY(rx);
I32 result;
RXi_GET_DECL(prog,progi);
GET_RE_DEBUG_FLAGS_DECL;
reginfo->cutpoint=NULL;
- if ((prog->extflags & RXf_EVAL_SEEN)
- && !PL_reg_state.re_state_eval_setup_done)
- {
- MAGIC *mg;
-
- PL_reg_state.re_state_eval_setup_done = TRUE;
- if (reginfo->sv) {
- /* Make $_ available to executed code. */
- if (reginfo->sv != DEFSV) {
- SAVE_DEFSV;
- DEFSV_set(reginfo->sv);
- }
-
- if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
- && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
- /* prepare for quick setting of pos */
-#ifdef PERL_OLD_COPY_ON_WRITE
- if (SvIsCOW(reginfo->sv))
- sv_force_normal_flags(reginfo->sv, 0);
-#endif
- mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
- &PL_vtbl_mglob, NULL, 0);
- mg->mg_len = -1;
- }
- PL_reg_magic = mg;
- PL_reg_oldpos = mg->mg_len;
- SAVEDESTRUCTOR_X(restore_pos, prog);
- }
- if (!PL_reg_curpm) {
- Newxz(PL_reg_curpm, 1, PMOP);
-#ifdef USE_ITHREADS
- {
- SV* const repointer = &PL_sv_undef;
- /* this regexp is also owned by the new PL_reg_curpm, which
- will try to free it. */
- av_push(PL_regex_padav, repointer);
- PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
- PL_regex_pad = AvARRAY(PL_regex_padav);
- }
-#endif
- }
- SET_reg_curpm(rx);
- PL_reg_oldcurpm = PL_curpm;
- PL_curpm = PL_reg_curpm;
- if (RXp_MATCH_COPIED(prog)) {
- /* Here is a serious problem: we cannot rewrite subbeg,
- since it may be needed if this match fails. Thus
- $` inside (?{}) could fail... */
- PL_reg_oldsaved = prog->subbeg;
- PL_reg_oldsavedlen = prog->sublen;
- PL_reg_oldsavedoffset = prog->suboffset;
- PL_reg_oldsavedcoffset = prog->suboffset;
-#ifdef PERL_OLD_COPY_ON_WRITE
- PL_nrs = prog->saved_copy;
-#endif
- RXp_MATCH_COPIED_off(prog);
- }
- else
- PL_reg_oldsaved = NULL;
- prog->subbeg = PL_bostr;
- prog->suboffset = 0;
- prog->subcoffset = 0;
- prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
- }
-#ifdef DEBUGGING
- PL_reg_starttry = *startposp;
-#endif
- prog->offs[0].start = *startposp - PL_bostr;
+ prog->offs[0].start = *startposp - reginfo->strbeg;
prog->lastparen = 0;
prog->lastcloseparen = 0;
- PL_regsize = 0;
/* XXXX What this code is doing here?!!! There should be no need
to do this again and again, prog->lastparen should take care of
"unreachable code" warnings, which are bogus, but distracting. */
#define CACHEsayNO \
if (ST.cache_mask) \
- PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
+ reginfo->info_aux->poscache[ST.cache_offset] |= ST.cache_mask; \
sayNO
/* this is used to determine how far from the left messages like
#define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
#define CHRTEST_VOID -1000 /* the c1/c2 "next char" test should be skipped */
-
-#define SLAB_FIRST(s) (&(s)->states[0])
-#define SLAB_LAST(s) (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
+#define CHRTEST_NOT_A_CP_1 -999
+#define CHRTEST_NOT_A_CP_2 -998
/* grab a new slab and return the first slot in it */
}
-/* free all slabs above current one - called during LEAVE_SCOPE */
-
-STATIC void
-S_clear_backtrack_stack(pTHX_ void *p)
-{
- regmatch_slab *s = PL_regmatch_slab->next;
- PERL_UNUSED_ARG(p);
-
- if (!s)
- return;
- PL_regmatch_slab->next = NULL;
- while (s) {
- regmatch_slab * const osl = s;
- s = s->next;
- Safefree(osl);
- }
-}
static bool
-S_setup_EXACTISH_ST_c1_c2(pTHX_ regnode *text_node, I32 *c1, I32 *c2)
+S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p,
+ U8* c1_utf8, int *c2p, U8* c2_utf8, regmatch_info *reginfo)
{
- /* This sets up a relatively quick check for the initial part of what must
- * match after a CURLY-type operation condition (the "B" in A*B), where B
- * starts with an EXACTish node, <text_node>. If this check is not met,
- * the caller knows that it should continue with the loop. If the check is
- * met, the caller must see if all of B is met, before making the decision.
+ /* This function determines if there are one or two characters that match
+ * the first character of the passed-in EXACTish node <text_node>, and if
+ * so, returns them in the passed-in pointers.
+ *
+ * If it determines that no possible character in the target string can
+ * match, it returns FALSE; otherwise TRUE. (The FALSE situation occurs if
+ * the first character in <text_node> requires UTF-8 to represent, and the
+ * target string isn't in UTF-8.)
+ *
+ * If there are more than two characters that could match the beginning of
+ * <text_node>, or if more context is required to determine a match or not,
+ * it sets both *<c1p> and *<c2p> to CHRTEST_VOID.
*
- * This function sets *<c1> and *<c2> to be the first code point of B. If
- * there are two possible such code points (as when the text_node is
- * folded), *<c2> is set to the second. If there are more than two (which
- * happens for some folds), or there is some other complication, these
- * parameters are set to CHRTEST_VOID, to indicate not to do a quick check:
- * just try all of B after every time through the loop.
+ * The motiviation behind this function is to allow the caller to set up
+ * tight loops for matching. If <text_node> is of type EXACT, there is
+ * only one possible character that can match its first character, and so
+ * the situation is quite simple. But things get much more complicated if
+ * folding is involved. It may be that the first character of an EXACTFish
+ * node doesn't participate in any possible fold, e.g., punctuation, so it
+ * can be matched only by itself. The vast majority of characters that are
+ * in folds match just two things, their lower and upper-case equivalents.
+ * But not all are like that; some have multiple possible matches, or match
+ * sequences of more than one character. This function sorts all that out.
*
- * If the routine determines that there is no possible way for there to be
- * a match, it returns FALSE.
- * */
+ * Consider the patterns A*B or A*?B where A and B are arbitrary. In a
+ * loop of trying to match A*, we know we can't exit where the thing
+ * following it isn't a B. And something can't be a B unless it is the
+ * beginning of B. By putting a quick test for that beginning in a tight
+ * loop, we can rule out things that can't possibly be B without having to
+ * break out of the loop, thus avoiding work. Similarly, if A is a single
+ * character, we can make a tight loop matching A*, using the outputs of
+ * this function.
+ *
+ * If the target string to match isn't in UTF-8, and there aren't
+ * complications which require CHRTEST_VOID, *<c1p> and *<c2p> are set to
+ * the one or two possible octets (which are characters in this situation)
+ * that can match. In all cases, if there is only one character that can
+ * match, *<c1p> and *<c2p> will be identical.
+ *
+ * If the target string is in UTF-8, the buffers pointed to by <c1_utf8>
+ * and <c2_utf8> will contain the one or two UTF-8 sequences of bytes that
+ * can match the beginning of <text_node>. They should be declared with at
+ * least length UTF8_MAXBYTES+1. (If the target string isn't in UTF-8, it is
+ * undefined what these contain.) If one or both of the buffers are
+ * invariant under UTF-8, *<c1p>, and *<c2p> will also be set to the
+ * corresponding invariant. If variant, the corresponding *<c1p> and/or
+ * *<c2p> will be set to a negative number(s) that shouldn't match any code
+ * point (unless inappropriately coerced to unsigned). *<c1p> will equal
+ * *<c2p> if and only if <c1_utf8> and <c2_utf8> are the same. */
+
+ const bool utf8_target = reginfo->is_utf8_target;
+
+ UV c1 = CHRTEST_NOT_A_CP_1;
+ UV c2 = CHRTEST_NOT_A_CP_2;
+ bool use_chrtest_void = FALSE;
+ const bool is_utf8_pat = reginfo->is_utf8_pat;
+
+ /* Used when we have both utf8 input and utf8 output, to avoid converting
+ * to/from code points */
+ bool utf8_has_been_setup = FALSE;
- const bool utf8_target = PL_reg_match_utf8;
- const U32 uniflags = UTF8_ALLOW_DEFAULT;
dVAR;
- /* First byte from the EXACTish node */
- U8 *pat_byte = (U8*)STRING(text_node);
+ U8 *pat = (U8*)STRING(text_node);
+
+ if (OP(text_node) == EXACT) {
+
+ /* In an exact node, only one thing can be matched, that first
+ * character. If both the pat and the target are UTF-8, we can just
+ * copy the input to the output, avoiding finding the code point of
+ * that character */
+ if (!is_utf8_pat) {
+ c2 = c1 = *pat;
+ }
+ else if (utf8_target) {
+ Copy(pat, c1_utf8, UTF8SKIP(pat), U8);
+ Copy(pat, c2_utf8, UTF8SKIP(pat), U8);
+ utf8_has_been_setup = TRUE;
+ }
+ else {
+ c2 = c1 = valid_utf8_to_uvchr(pat, NULL);
+ }
+ }
+ else /* an EXACTFish node */
+ if ((is_utf8_pat
+ && is_MULTI_CHAR_FOLD_utf8_safe(pat,
+ pat + STR_LEN(text_node)))
+ || (!is_utf8_pat
+ && is_MULTI_CHAR_FOLD_latin1_safe(pat,
+ pat + STR_LEN(text_node))))
+ {
+ /* Multi-character folds require more context to sort out. Also
+ * PL_utf8_foldclosures used below doesn't handle them, so have to be
+ * handled outside this routine */
+ use_chrtest_void = TRUE;
+ }
+ 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) {
+ /* Load the folds hash, if not already done */
+ SV** listp;
+ if (! PL_utf8_foldclosures) {
+ if (! PL_utf8_tofold) {
+ U8 dummy[UTF8_MAXBYTES+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);
+ }
+
+ /* The fold closures data structure is a hash with the keys being
+ * the UTF-8 of every character that is folded to, like 'k', and
+ * the values each an array of all code points that fold to its
+ * key. e.g. [ 'k', 'K', KELVIN_SIGN ]. Multi-character folds are
+ * not included */
+ if ((! (listp = hv_fetch(PL_utf8_foldclosures,
+ (char *) pat,
+ UTF8SKIP(pat),
+ FALSE))))
+ {
+ /* Not found in the hash, therefore there are no folds
+ * containing it, so there is only a single character that
+ * could match */
+ c2 = c1;
+ }
+ else { /* Does participate in folds */
+ AV* list = (AV*) *listp;
+ if (av_len(list) != 1) {
+
+ /* If there aren't exactly two folds to this, it is outside
+ * the scope of this function */
+ use_chrtest_void = TRUE;
+ }
+ else { /* There are two. Get them */
+ SV** c_p = av_fetch(list, 0, FALSE);
+ if (c_p == NULL) {
+ Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
+ }
+ c1 = SvUV(*c_p);
- if (! UTF_PATTERN) { /* Not UTF-8: the code point is the byte */
- *c1 = *pat_byte;
- if (OP(text_node) == EXACT) {
- *c2 = *c1;
+ c_p = av_fetch(list, 1, FALSE);
+ if (c_p == NULL) {
+ Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
+ }
+ c2 = SvUV(*c_p);
+
+ /* Folds that cross the 255/256 boundary are forbidden if
+ * EXACTFL, or EXACTFA and one is ASCIII. Since the
+ * pattern character is above 256, 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 */
+ if ((c1 < 256) != (c2 < 256)) {
+ if (OP(text_node) == EXACTFL
+ || (OP(text_node) == EXACTFA
+ && (isASCII(c1) || isASCII(c2))))
+ {
+ if (c1 < 256) {
+ c1 = c2;
+ }
+ else {
+ c2 = c1;
+ }
+ }
+ }
+ }
+ }
}
- else if (utf8_target
- && HAS_NONLATIN1_FOLD_CLOSURE(*c1)
- && (OP(text_node) != EXACTFA || ! isASCII(*c1)))
+ else /* Here, c1 is < 255 */
+ if (utf8_target
+ && HAS_NONLATIN1_FOLD_CLOSURE(c1)
+ && OP(text_node) != EXACTFL
+ && (OP(text_node) != EXACTFA || ! isASCII(c1)))
{
/* Here, there could be something above Latin1 in the target which
- * folds to this character in the pattern, which means there are
- * more than two possible beginnings of B. */
- *c1 = *c2 = CHRTEST_VOID;
+ * folds to this character in the pattern. All such cases except
+ * LATIN SMALL LETTER Y WITH DIAERESIS have more than two characters
+ * involved in their folds, so are outside the scope of this
+ * function */
+ if (UNLIKELY(c1 == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) {
+ c2 = LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS;
+ }
+ else {
+ use_chrtest_void = TRUE;
+ }
}
else { /* Here nothing above Latin1 can fold to the pattern character */
switch (OP(text_node)) {
case EXACTFL: /* /l rules */
- *c2 = PL_fold_locale[*c1];
- break;
-
- case EXACTFU_SS: /* This requires special handling: Don't
- shortcut */
- *c1 = *c2 = CHRTEST_VOID;
+ c2 = PL_fold_locale[c1];
break;
case EXACTF:
if (! utf8_target) { /* /d rules */
- *c2 = PL_fold[*c1];
+ c2 = PL_fold[c1];
break;
}
/* FALLTHROUGH */
/* /u rules for all these. This happens to work for
- * EXACTFA in the ASCII range as nothing in Latin1 folds to
- * ASCII */
+ * EXACTFA as nothing in Latin1 folds to ASCII */
case EXACTFA:
case EXACTFU_TRICKYFOLD:
+ case EXACTFU_SS:
case EXACTFU:
- *c2 = PL_fold_latin1[*c1];
+ c2 = PL_fold_latin1[c1];
break;
- default: Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node));
+ default:
+ Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node));
+ assert(0); /* NOTREACHED */
}
}
}
- else { /* UTF_PATTERN */
- if (OP(text_node) == EXACT) {
- *c2 = *c1 = utf8n_to_uvchr(pat_byte, UTF8_MAXBYTES, 0, uniflags);
- if (*c1 < 0) { /* Overflowed what we can handle */
- *c1 = *c2 = CHRTEST_VOID;
- }
- else if (*c1 > 255 && ! utf8_target) {
- return FALSE; /* Can't possibly match */
- }
+
+ /* Here have figured things out. Set up the returns */
+ if (use_chrtest_void) {
+ *c2p = *c1p = CHRTEST_VOID;
+ }
+ else if (utf8_target) {
+ if (! utf8_has_been_setup) { /* Don't have the utf8; must get it */
+ uvchr_to_utf8(c1_utf8, c1);
+ uvchr_to_utf8(c2_utf8, c2);
}
- else {
- if (UTF8_IS_ABOVE_LATIN1(*pat_byte)) {
- /* A multi-character fold is complicated, probably has more
- * than two possibilities */
- if (is_MULTI_CHAR_FOLD_utf8_safe((char*) pat_byte,
- (char*) pat_byte + STR_LEN(text_node)))
- {
- *c1 = *c2 = CHRTEST_VOID;
- }
- else { /* Not a multi-char fold */
-
- /* Load the folds hash, if not already done */
- SV** listp;
- if (! PL_utf8_foldclosures) {
- if (! PL_utf8_tofold) {
- U8 dummy[UTF8_MAXBYTES+1];
- STRLEN dummy_len;
-
- /* Force loading this by folding an above-Latin1
- * char */
- to_utf8_fold((U8*) HYPHEN_UTF8, dummy, &dummy_len);
- assert(PL_utf8_tofold); /* Verify that worked */
- }
- PL_utf8_foldclosures =
- _swash_inversion_hash(PL_utf8_tofold);
- }
+ /* Invariants are stored in both the utf8 and byte outputs; Use
+ * negative numbers otherwise for the byte ones. Make sure that the
+ * byte ones are the same iff the utf8 ones are the same */
+ *c1p = (UTF8_IS_INVARIANT(*c1_utf8)) ? *c1_utf8 : CHRTEST_NOT_A_CP_1;
+ *c2p = (UTF8_IS_INVARIANT(*c2_utf8))
+ ? *c2_utf8
+ : (c1 == c2)
+ ? CHRTEST_NOT_A_CP_1
+ : CHRTEST_NOT_A_CP_2;
+ }
+ else if (c1 > 255) {
+ if (c2 > 255) { /* both possibilities are above what a non-utf8 string
+ can represent */
+ return FALSE;
+ }
- /* The fold closures data structure is a hash with the keys
- * being every character that is folded to, like 'k', and
- * the values each an array of everything that folds to its
- * key. e.g. [ 'k', 'K', KELVIN_SIGN ] */
- if ((! (listp = hv_fetch(PL_utf8_foldclosures,
- (char *) pat_byte,
- UTF8SKIP(pat_byte),
- FALSE))))
- {
- /* Not found in the hash, therefore there are no folds
- * containing it, so there is only a single char
- * possible for beginning B */
- *c2 = *c1 = utf8n_to_uvchr(pat_byte, STR_LEN(text_node),
- 0, uniflags);
- if (*c1 < 0) { /* Overflowed what we can handle */
- *c1 = *c2 = CHRTEST_VOID;
- }
- }
- else {
- AV* list = (AV*) *listp;
- if (av_len(list) != 1) { /* If there aren't exactly
- two folds to this, have
- to test B completely */
- *c1 = *c2 = CHRTEST_VOID;
- }
- else { /* There are two. Set *c1 and *c2 to them */
- SV** c_p = av_fetch(list, 0, FALSE);
- if (c_p == NULL) {
- Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
- }
- *c1 = SvUV(*c_p);
- c_p = av_fetch(list, 1, FALSE);
- if (c_p == NULL) {
- Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure");
- }
- *c2 = SvUV(*c_p);
- }
- }
- }
- }
- else {
- /* Get the character represented by the UTF-8-encoded byte */
- U8 c = (UTF8_IS_INVARIANT(*pat_byte))
- ? *pat_byte
- : TWO_BYTE_UTF8_TO_UNI(*pat_byte, *(pat_byte+1));
-
- if (HAS_NONLATIN1_FOLD_CLOSURE(c)
- && (OP(text_node) != EXACTFA || ! isASCII(c)))
- { /* Something above Latin1 folds to this; hence there are
- more than 2 possibilities for B to begin with */
- *c1 = *c2 = CHRTEST_VOID;
- }
- else {
- *c1 = c;
- *c2 = (OP(text_node) == EXACTFL)
- ? PL_fold_locale[*c1]
- : PL_fold_latin1[*c1];
- }
- }
- }
+ *c1p = *c2p = c2; /* c2 is the only representable value */
+ }
+ else { /* c1 is representable; see about c2 */
+ *c1p = c1;
+ *c2p = (c2 < 256) ? c2 : c1;
}
return TRUE;
dMY_CXT;
#endif
dVAR;
- const bool utf8_target = PL_reg_match_utf8;
+ const bool utf8_target = reginfo->is_utf8_target;
const U32 uniflags = UTF8_ALLOW_DEFAULT;
REGEXP *rex_sv = reginfo->prog;
- regexp *rex = (struct regexp *)SvANY(rex_sv);
+ regexp *rex = ReANY(rex_sv);
RXi_GET_DECL(rex,rexi);
- I32 oldsave;
/* the current state. This is a cached copy of PL_regmatch_state */
regmatch_state *st;
/* cache heavy used fields of st in registers */
CV *caller_cv = NULL; /* who called us */
CV *last_pushed_cv = NULL; /* most recently called (?{}) CV */
CHECKPOINT runops_cp; /* savestack position before executing EVAL */
+ U32 maxopenparen = 0; /* max '(' index seen so far */
+ int to_complement; /* Invert the result? */
+ _char_class_number classnum;
+ bool is_utf8_pat = reginfo->is_utf8_pat;
#ifdef DEBUGGING
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
PerlIO_printf(Perl_debug_log,"regmatch start\n");
}));
- /* on first ever call to regmatch, allocate first slab */
- if (!PL_regmatch_slab) {
- Newx(PL_regmatch_slab, 1, regmatch_slab);
- PL_regmatch_slab->prev = NULL;
- PL_regmatch_slab->next = NULL;
- PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
- }
-
- oldsave = PL_savestack_ix;
- SAVEDESTRUCTOR_X(S_clear_backtrack_stack, NULL);
- SAVEVPTR(PL_regmatch_slab);
- SAVEVPTR(PL_regmatch_state);
- /* grab next free state slot */
- st = ++PL_regmatch_state;
- if (st > SLAB_LAST(PL_regmatch_slab))
- st = PL_regmatch_state = S_push_slab(aTHX);
+ st = PL_regmatch_state;
/* Note that nextchr is a byte even in UTF */
SET_nextchr;
state_num = OP(scan);
reenter_switch:
+ to_complement = 0;
SET_nextchr;
+ assert(nextchr < 256 && (nextchr >= 0 || nextchr == NEXTCHR_EOS));
switch (state_num) {
case BOL: /* /^../ */
- if (locinput == PL_bostr)
- {
- /* reginfo->till = reginfo->bol; */
+ if (locinput == reginfo->strbeg)
break;
- }
sayNO;
case MBOL: /* /^../m */
- if (locinput == PL_bostr ||
+ if (locinput == reginfo->strbeg ||
(!NEXTCHR_IS_EOS && locinput[-1] == '\n'))
{
break;
sayNO;
case SBOL: /* /^../s */
- if (locinput == PL_bostr)
+ if (locinput == reginfo->strbeg)
break;
sayNO;
case KEEPS: /* \K */
/* update the startpoint */
st->u.keeper.val = rex->offs[0].start;
- rex->offs[0].start = locinput - PL_bostr;
+ rex->offs[0].start = locinput - reginfo->strbeg;
PUSH_STATE_GOTO(KEEPS_next, next, locinput);
- /*NOT-REACHED*/
+ assert(0); /*NOTREACHED*/
case KEEPS_next_fail:
/* rollback the start point change */
rex->offs[0].start = st->u.keeper.val;
sayNO_SILENT;
- /*NOT-REACHED*/
+ assert(0); /*NOTREACHED*/
case EOL: /* /..$/ */
goto seol;
seol:
if (!NEXTCHR_IS_EOS && nextchr != '\n')
sayNO;
- if (PL_regeol - locinput > 1)
+ if (reginfo->strend - locinput > 1)
sayNO;
break;
shortest accept state and the wordnum of the longest
accept state */
- while ( state && uc <= (U8*)PL_regeol ) {
+ while ( state && uc <= (U8*)(reginfo->strend) ) {
U32 base = trie->states[ state ].trans.base;
UV uvc = 0;
U16 charid = 0;
});
/* read a char and goto next state */
- if ( base && (foldlen || uc < (U8*)PL_regeol)) {
+ if ( base && (foldlen || uc < (U8*)(reginfo->strend))) {
I32 offset;
REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
uscan, len, uvc, charid, foldlen,
case EXACT: { /* /abc/ */
char *s = STRING(scan);
ln = STR_LEN(scan);
- if (utf8_target != UTF_PATTERN) {
+ if (utf8_target != is_utf8_pat) {
/* The target and the pattern have differing utf8ness. */
char *l = locinput;
const char * const e = s + ln;
* is an invariant, but there are tests in the test suite
* dealing with (??{...}) which violate this) */
while (s < e) {
- if (l >= PL_regeol)
- sayNO;
- if (UTF8_IS_ABOVE_LATIN1(* (U8*) l)) {
+ if (l >= reginfo->strend
+ || UTF8_IS_ABOVE_LATIN1(* (U8*) l))
+ {
sayNO;
}
if (UTF8_IS_INVARIANT(*(U8*)l)) {
else {
/* The target is not utf8, the pattern is utf8. */
while (s < e) {
- if (l >= PL_regeol || UTF8_IS_ABOVE_LATIN1(* (U8*) s))
+ if (l >= reginfo->strend
+ || UTF8_IS_ABOVE_LATIN1(* (U8*) s))
{
sayNO;
}
}
}
locinput = l;
- break;
}
- /* The target and the pattern have the same utf8ness. */
- /* Inline the first character, for speed. */
- if (UCHARAT(s) != nextchr)
- sayNO;
- if (PL_regeol - locinput < ln)
- sayNO;
- if (ln > 1 && memNE(s, locinput, ln))
- sayNO;
- locinput += ln;
+ else {
+ /* The target and the pattern have the same utf8ness. */
+ /* Inline the first character, for speed. */
+ if (reginfo->strend - locinput < ln
+ || UCHARAT(s) != nextchr
+ || (ln > 1 && memNE(s, locinput, ln)))
+ {
+ sayNO;
+ }
+ locinput += ln;
+ }
break;
}
const char * s;
U32 fold_utf8_flags;
- PL_reg_flags |= RF_tainted;
- folder = foldEQ_locale;
- fold_array = PL_fold_locale;
+ RX_MATCH_TAINTED_on(reginfo->prog);
+ folder = foldEQ_locale;
+ fold_array = PL_fold_locale;
fold_utf8_flags = FOLDEQ_UTF8_LOCALE;
goto do_exactf;
case EXACTFU: /* /abc/iu */
folder = foldEQ_latin1;
fold_array = PL_fold_latin1;
- fold_utf8_flags = (UTF_PATTERN) ? FOLDEQ_S1_ALREADY_FOLDED : 0;
+ fold_utf8_flags = is_utf8_pat ? FOLDEQ_S1_ALREADY_FOLDED : 0;
goto do_exactf;
case EXACTFA: /* /abc/iaa */
s = STRING(scan);
ln = STR_LEN(scan);
- if (utf8_target || UTF_PATTERN || state_num == EXACTFU_SS) {
+ if (utf8_target || is_utf8_pat || state_num == EXACTFU_SS) {
/* Either target or the pattern are utf8, or has the issue where
* the fold lengths may differ. */
const char * const l = locinput;
- char *e = PL_regeol;
+ char *e = reginfo->strend;
- if (! foldEQ_utf8_flags(s, 0, ln, cBOOL(UTF_PATTERN),
+ if (! foldEQ_utf8_flags(s, 0, ln, is_utf8_pat,
l, &e, 0, utf8_target, fold_utf8_flags))
{
sayNO;
}
/* Neither the target nor the pattern are utf8 */
- if (UCHARAT(s) != nextchr &&
- UCHARAT(s) != fold_array[nextchr])
+ if (UCHARAT(s) != nextchr
+ && !NEXTCHR_IS_EOS
+ && UCHARAT(s) != fold_array[nextchr])
{
sayNO;
}
- if (PL_regeol - locinput < ln)
+ if (reginfo->strend - locinput < ln)
sayNO;
if (ln > 1 && ! folder(s, locinput, ln))
sayNO;
* have to set the FLAGS fields of these */
case BOUNDL: /* /\b/l */
case NBOUNDL: /* /\B/l */
- PL_reg_flags |= RF_tainted;
+ RX_MATCH_TAINTED_on(reginfo->prog);
/* FALL THROUGH */
case BOUND: /* /\b/ */
case BOUNDU: /* /\b/u */
&& FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET
&& FLAGS(scan) != REGEX_ASCII_MORE_RESTRICTED_CHARSET)
{
- if (locinput == PL_bostr)
+ if (locinput == reginfo->strbeg)
ln = '\n';
else {
- const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
+ const U8 * const r =
+ reghop3((U8*)locinput, -1, (U8*)(reginfo->strbeg));
ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
}
if (FLAGS(scan) != REGEX_LOCALE_CHARSET) {
- ln = isALNUM_uni(ln);
+ ln = isWORDCHAR_uni(ln);
if (NEXTCHR_IS_EOS)
n = 0;
else {
LOAD_UTF8_CHARCLASS_ALNUM();
- n = swash_fetch(PL_utf8_alnum, (U8*)locinput,
+ n = swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)locinput,
utf8_target);
}
}
else {
- ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
- n = NEXTCHR_IS_EOS ? 0 : isALNUM_LC_utf8((U8*)locinput);
+ ln = isWORDCHAR_LC_uvchr(UNI_TO_NATIVE(ln));
+ n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_LC_utf8((U8*)locinput);
}
}
else {
* byte is never mistakable for ASCII, and so the test
* will say it is not a word character, which is the
* correct answer. */
- ln = (locinput != PL_bostr) ?
+ ln = (locinput != reginfo->strbeg) ?
UCHARAT(locinput - 1) : '\n';
switch (FLAGS(scan)) {
case REGEX_UNICODE_CHARSET:
n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_L1(nextchr);
break;
case REGEX_LOCALE_CHARSET:
- ln = isALNUM_LC(ln);
- n = NEXTCHR_IS_EOS ? 0 : isALNUM_LC(nextchr);
+ ln = isWORDCHAR_LC(ln);
+ n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_LC(nextchr);
break;
case REGEX_DEPENDS_CHARSET:
- ln = isALNUM(ln);
- n = NEXTCHR_IS_EOS ? 0 : isALNUM(nextchr);
+ ln = isWORDCHAR(ln);
+ n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR(nextchr);
break;
case REGEX_ASCII_RESTRICTED_CHARSET:
case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
sayNO;
break;
- case ANYOFV: /* /[abx{df}]/i */
case ANYOF: /* /[abc]/ */
+ case ANYOF_WARN_SUPER:
if (NEXTCHR_IS_EOS)
sayNO;
- if (utf8_target || state_num == ANYOFV) {
- STRLEN inclasslen = PL_regeol - locinput;
- if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, utf8_target))
+ if (utf8_target) {
+ if (!reginclass(rex, scan, (U8*)locinput, utf8_target))
sayNO;
- locinput += inclasslen;
- break;
+ locinput += UTF8SKIP(locinput);
}
else {
if (!REGINCLASS(rex, scan, (U8*)locinput))
sayNO;
locinput++;
- break;
}
break;
- /* Special char classes: \d, \w etc.
- * The defines start on line 166 or so */
- CCC_TRY_U(ALNUM, NALNUM, isWORDCHAR,
- ALNUML, NALNUML, isALNUM_LC, isALNUM_LC_utf8,
- ALNUMU, NALNUMU, isWORDCHAR_L1,
- ALNUMA, NALNUMA, isWORDCHAR_A,
- alnum, "a");
-
- CCC_TRY_U(SPACE, NSPACE, isSPACE,
- SPACEL, NSPACEL, isSPACE_LC, isSPACE_LC_utf8,
- SPACEU, NSPACEU, isSPACE_L1,
- SPACEA, NSPACEA, isSPACE_A,
- space, " ");
-
- CCC_TRY(DIGIT, NDIGIT, isDIGIT,
- DIGITL, NDIGITL, isDIGIT_LC, isDIGIT_LC_utf8,
- DIGITA, NDIGITA, isDIGIT_A,
- digit, "0");
-
- case POSIXA: /* /[[:ascii:]]/ etc */
- if (NEXTCHR_IS_EOS || ! _generic_isCC_A(nextchr, FLAGS(scan))) {
+ /* The argument (FLAGS) to all the POSIX node types is the class number
+ * */
+
+ case NPOSIXL: /* \W or [:^punct:] etc. under /l */
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case POSIXL: /* \w or [:punct:] etc. under /l */
+ if (NEXTCHR_IS_EOS)
sayNO;
+
+ /* The locale hasn't influenced the outcome before this, so defer
+ * tainting until now */
+ RX_MATCH_TAINTED_on(reginfo->prog);
+
+ /* Use isFOO_lc() for characters within Latin1. (Note that
+ * UTF8_IS_INVARIANT works even on non-UTF-8 strings, or else
+ * wouldn't be invariant) */
+ if (UTF8_IS_INVARIANT(nextchr) || ! utf8_target) {
+ if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan), (U8) nextchr)))) {
+ sayNO;
+ }
}
- /* Matched a utf8-invariant, so don't have to worry about utf8 */
- locinput++;
+ else if (UTF8_IS_DOWNGRADEABLE_START(nextchr)) {
+ if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan),
+ (U8) TWO_BYTE_UTF8_TO_UNI(nextchr,
+ *(locinput + 1))))))
+ {
+ sayNO;
+ }
+ }
+ else { /* Here, must be an above Latin-1 code point */
+ goto utf8_posix_not_eos;
+ }
+
+ /* Here, must be utf8 */
+ locinput += UTF8SKIP(locinput);
break;
- case NPOSIXA: /* /[^[:ascii:]]/ etc */
- if (NEXTCHR_IS_EOS || _generic_isCC_A(nextchr, FLAGS(scan))) {
- sayNO;
+ case NPOSIXD: /* \W or [:^punct:] etc. under /d */
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case POSIXD: /* \w or [:punct:] etc. under /d */
+ if (utf8_target) {
+ goto utf8_posix;
}
- goto increment_locinput;
+ goto posixa;
- case CLUMP: /* Match \X: logical Unicode character. This is defined as
- a Unicode extended Grapheme Cluster */
- /* From http://www.unicode.org/reports/tr29 (5.2 version). An
- extended Grapheme Cluster is:
+ case NPOSIXA: /* \W or [:^punct:] etc. under /a */
- CR LF
- | Prepend* Begin Extend*
- | .
+ if (NEXTCHR_IS_EOS) {
+ sayNO;
+ }
- Begin is: ( Special_Begin | ! Control )
- Special_Begin is: ( Regional-Indicator+ | Hangul-syllable )
- Extend is: ( Grapheme_Extend | Spacing_Mark )
- Control is: [ GCB_Control CR LF ]
- Hangul-syllable is: ( T+ | ( L* ( L | ( LVT | ( V | LV ) V* ) T* ) ))
+ /* All UTF-8 variants match */
+ if (! UTF8_IS_INVARIANT(nextchr)) {
+ goto increment_locinput;
+ }
+
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case POSIXA: /* \w or [:punct:] etc. under /a */
+
+ posixa:
+ /* We get here through POSIXD, NPOSIXD, and NPOSIXA when not in
+ * UTF-8, and also from NPOSIXA even in UTF-8 when the current
+ * character is a single byte */
+
+ if (NEXTCHR_IS_EOS
+ || ! (to_complement ^ cBOOL(_generic_isCC_A(nextchr,
+ FLAGS(scan)))))
+ {
+ sayNO;
+ }
+
+ /* Here we are either not in utf8, or we matched a utf8-invariant,
+ * so the next char is the next byte */
+ locinput++;
+ break;
+
+ case NPOSIXU: /* \W or [:^punct:] etc. under /u */
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case POSIXU: /* \w or [:punct:] etc. under /u */
+ utf8_posix:
+ if (NEXTCHR_IS_EOS) {
+ sayNO;
+ }
+ utf8_posix_not_eos:
+
+ /* Use _generic_isCC() for characters within Latin1. (Note that
+ * UTF8_IS_INVARIANT works even on non-UTF-8 strings, or else
+ * wouldn't be invariant) */
+ if (UTF8_IS_INVARIANT(nextchr) || ! utf8_target) {
+ if (! (to_complement ^ cBOOL(_generic_isCC(nextchr,
+ FLAGS(scan)))))
+ {
+ sayNO;
+ }
+ locinput++;
+ }
+ else if (UTF8_IS_DOWNGRADEABLE_START(nextchr)) {
+ if (! (to_complement
+ ^ cBOOL(_generic_isCC(TWO_BYTE_UTF8_TO_UNI(nextchr,
+ *(locinput + 1)),
+ FLAGS(scan)))))
+ {
+ sayNO;
+ }
+ locinput += 2;
+ }
+ else { /* Handle above Latin-1 code points */
+ classnum = (_char_class_number) FLAGS(scan);
+ if (classnum < _FIRST_NON_SWASH_CC) {
+
+ /* Here, uses a swash to find such code points. Load if if
+ * not done already */
+ if (! PL_utf8_swash_ptrs[classnum]) {
+ U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
+ PL_utf8_swash_ptrs[classnum]
+ = _core_swash_init("utf8",
+ swash_property_names[classnum],
+ &PL_sv_undef, 1, 0, NULL, &flags);
+ }
+ if (! (to_complement
+ ^ cBOOL(swash_fetch(PL_utf8_swash_ptrs[classnum],
+ (U8 *) locinput, TRUE))))
+ {
+ sayNO;
+ }
+ }
+ else { /* Here, uses macros to find above Latin-1 code points */
+ switch (classnum) {
+ case _CC_ENUM_SPACE: /* XXX would require separate
+ code if we revert the change
+ of \v matching this */
+ case _CC_ENUM_PSXSPC:
+ if (! (to_complement
+ ^ cBOOL(is_XPERLSPACE_high(locinput))))
+ {
+ sayNO;
+ }
+ break;
+ case _CC_ENUM_BLANK:
+ if (! (to_complement
+ ^ cBOOL(is_HORIZWS_high(locinput))))
+ {
+ sayNO;
+ }
+ break;
+ case _CC_ENUM_XDIGIT:
+ if (! (to_complement
+ ^ cBOOL(is_XDIGIT_high(locinput))))
+ {
+ sayNO;
+ }
+ break;
+ case _CC_ENUM_VERTSPACE:
+ if (! (to_complement
+ ^ cBOOL(is_VERTWS_high(locinput))))
+ {
+ sayNO;
+ }
+ break;
+ default: /* The rest, e.g. [:cntrl:], can't match
+ above Latin1 */
+ if (! to_complement) {
+ sayNO;
+ }
+ break;
+ }
+ }
+ locinput += UTF8SKIP(locinput);
+ }
+ break;
+
+ case CLUMP: /* Match \X: logical Unicode character. This is defined as
+ a Unicode extended Grapheme Cluster */
+ /* From http://www.unicode.org/reports/tr29 (5.2 version). An
+ extended Grapheme Cluster is:
+
+ CR LF
+ | Prepend* Begin Extend*
+ | .
+
+ Begin is: ( Special_Begin | ! Control )
+ Special_Begin is: ( Regional-Indicator+ | Hangul-syllable )
+ Extend is: ( Grapheme_Extend | Spacing_Mark )
+ Control is: [ GCB_Control | CR | LF ]
+ Hangul-syllable is: ( T+ | ( L* ( L | ( LVT | ( V | LV ) V* ) T* ) ))
If we create a 'Regular_Begin' = Begin - Special_Begin, then
we can rewrite
locinput++; /* Match the . or CR */
if (nextchr == '\r' /* And if it was CR, and the next is LF,
match the LF */
- && locinput < PL_regeol
- && UCHARAT(locinput) == '\n') locinput++;
+ && locinput < reginfo->strend
+ && UCHARAT(locinput) == '\n')
+ {
+ locinput++;
+ }
}
else {
/* Utf8: See if is ( CR LF ); already know that locinput <
- * PL_regeol, so locinput+1 is in bounds */
- if ( nextchr == '\r' && locinput+1 < PL_regeol
- && UCHARAT(locinput + 1) == '\n')
+ * reginfo->strend, so locinput+1 is in bounds */
+ if ( nextchr == '\r' && locinput+1 < reginfo->strend
+ && UCHARAT(locinput + 1) == '\n')
{
locinput += 2;
}
char *starting = locinput;
/* In case have to backtrack the last prepend */
- char *previous_prepend = 0;
+ char *previous_prepend = NULL;
LOAD_UTF8_CHARCLASS_GCB();
/* Match (prepend)* */
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& (len = is_GCB_Prepend_utf8(locinput)))
{
previous_prepend = locinput;
* the next thing won't match, back off the last prepend we
* matched, as it is guaranteed to match the begin */
if (previous_prepend
- && (locinput >= PL_regeol
+ && (locinput >= reginfo->strend
|| (! swash_fetch(PL_utf8_X_regular_begin,
(U8*)locinput, utf8_target)
- && ! is_GCB_SPECIAL_BEGIN_utf8(locinput)))
+ && ! is_GCB_SPECIAL_BEGIN_START_utf8(locinput)))
)
{
locinput = previous_prepend;
}
- /* Note that here we know PL_regeol > locinput, as we
+ /* Note that here we know reginfo->strend > locinput, as we
* tested that upon input to this switch case, and if we
* moved locinput forward, we tested the result just above
* and it either passed, or we backed off so that it will
(U8*)locinput, utf8_target)) {
locinput += UTF8SKIP(locinput);
}
- else if (! is_GCB_SPECIAL_BEGIN_utf8(locinput)) {
+ else if (! is_GCB_SPECIAL_BEGIN_START_utf8(locinput)) {
/* Here did not match the required 'Begin' in the
* second term. So just match the very first
* RI+ */
if ((len = is_GCB_RI_utf8(locinput))) {
locinput += len;
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& (len = is_GCB_RI_utf8(locinput)))
{
locinput += len;
} else if ((len = is_GCB_T_utf8(locinput))) {
/* Another possibility is T+ */
locinput += len;
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& (len = is_GCB_T_utf8(locinput)))
{
locinput += len;
* L* (L | LVT T* | V * V* T* | LV V* T*) */
/* Match L* */
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& (len = is_GCB_L_utf8(locinput)))
{
locinput += len;
* equation, we have a complete hangul syllable.
* Are done. */
- if (locinput < PL_regeol
+ if (locinput < reginfo->strend
&& is_GCB_LV_LVT_V_utf8(locinput))
{
-
/* Otherwise keep going. Must be LV, LVT or V.
- * See if LVT */
- if (is_utf8_X_LVT((U8*)locinput)) {
+ * See if LVT, by first ruling out V, then LV */
+ if (! is_GCB_V_utf8(locinput)
+ /* All but every TCount one is LV */
+ && (valid_utf8_to_uvchr((U8 *) locinput,
+ NULL)
+ - SBASE)
+ % TCount != 0)
+ {
locinput += UTF8SKIP(locinput);
} else {
/* Must be V or LV. Take it, then match
* V* */
locinput += UTF8SKIP(locinput);
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& (len = is_GCB_V_utf8(locinput)))
{
locinput += len;
/* And any of LV, LVT, or V can be followed
* by T* */
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& (len = is_GCB_T_utf8(locinput)))
{
locinput += len;
}
/* Match any extender */
- while (locinput < PL_regeol
+ while (locinput < reginfo->strend
&& swash_fetch(PL_utf8_X_extend,
(U8*)locinput, utf8_target))
{
}
}
exit_utf8:
- if (locinput > PL_regeol) sayNO;
+ if (locinput > reginfo->strend) sayNO;
}
break;
op. */
/* don't initialize these in the declaration, it makes C++
unhappy */
- char *s;
+ const char *s;
char type;
re_fold_t folder;
const U8 *fold_array;
UV utf8_fold_flags;
- PL_reg_flags |= RF_tainted;
+ RX_MATCH_TAINTED_on(reginfo->prog);
folder = foldEQ_locale;
fold_array = PL_fold_locale;
type = REFFL;
goto do_nref_ref_common;
case REFFL: /* /\1/il */
- PL_reg_flags |= RF_tainted;
+ RX_MATCH_TAINTED_on(reginfo->prog);
folder = foldEQ_locale;
fold_array = PL_fold_locale;
utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
do_nref_ref_common:
ln = rex->offs[n].start;
- PL_reg_leftiter = PL_reg_maxiter; /* Void cache */
+ reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
if (rex->lastparen < n || ln == -1)
sayNO; /* Do not match unless seen CLOSEn. */
if (ln == rex->offs[n].end)
break;
- s = PL_bostr + ln;
+ s = reginfo->strbeg + ln;
if (type != REF /* REF can do byte comparison */
&& (utf8_target || type == REFFU))
{ /* XXX handle REFFL better */
- char * limit = PL_regeol;
+ char * limit = reginfo->strend;
/* This call case insensitively compares the entire buffer
* at s, with the current input starting at locinput, but
- * not going off the end given by PL_regeol, and returns in
- * limit upon success, how much of the current input was
- * matched */
+ * not going off the end given by reginfo->strend, and
+ * returns in <limit> upon success, how much of the
+ * current input was matched */
if (! foldEQ_utf8_flags(s, NULL, rex->offs[n].end - ln, utf8_target,
locinput, &limit, 0, utf8_target, utf8_fold_flags))
{
UCHARAT(s) != fold_array[nextchr]))
sayNO;
ln = rex->offs[n].end - ln;
- if (locinput + ln > PL_regeol)
+ if (locinput + ln > reginfo->strend)
sayNO;
if (ln > 1 && (type == REF
? memNE(s, locinput, ln)
/* execute the code in the {...} */
dSP;
- SV ** before;
+ IV before;
OP * const oop = PL_op;
COP * const ocurcop = PL_curcop;
OP *nop;
- char *saved_regeol = PL_regeol;
- struct re_save_state saved_state;
CV *newcv;
/* save *all* paren positions */
- regcppush(rex, 0);
+ regcppush(rex, 0, maxopenparen);
REGCP_SET(runops_cp);
- /* To not corrupt the existing regex state while executing the
- * eval we would normally put it on the save stack, like with
- * save_re_context. However, re-evals have a weird scoping so we
- * can't just add ENTER/LEAVE here. With that, things like
- *
- * (?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a})
- *
- * would break, as they expect the localisation to be unwound
- * only when the re-engine backtracks through the bit that
- * localised it.
- *
- * What we do instead is just saving the state in a local c
- * variable.
- */
- Copy(&PL_reg_state, &saved_state, 1, struct re_save_state);
-
- PL_reg_state.re_reparsing = FALSE;
-
if (!caller_cv)
caller_cv = find_runcv(NULL);
n = ARG(scan);
if (rexi->data->what[n] == 'r') { /* code from an external qr */
- newcv = ((struct regexp *)SvANY(
+ newcv = (ReANY(
(REGEXP*)(rexi->data->data[n])
))->qr_anoncv
;
* points to newcv's pad. */
if (newcv != last_pushed_cv || PL_comppad != last_pad)
{
- I32 depth = (newcv == caller_cv) ? 0 : 1;
+ U8 flags = (CXp_SUB_RE |
+ ((newcv == caller_cv) ? CXp_SUB_RE_FAKE : 0));
if (last_pushed_cv) {
- CHANGE_MULTICALL_WITHDEPTH(newcv, depth);
+ CHANGE_MULTICALL_FLAGS(newcv, flags);
}
else {
- PUSH_MULTICALL_WITHDEPTH(newcv, depth);
+ PUSH_MULTICALL_FLAGS(newcv, flags);
}
last_pushed_cv = newcv;
}
+ else {
+ /* these assignments are just to silence compiler
+ * warnings */
+ multicall_cop = NULL;
+ newsp = NULL;
+ }
last_pad = PL_comppad;
/* the initial nextstate you would normally execute
DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
" re EVAL PL_op=0x%"UVxf"\n", PTR2UV(nop)) );
- rex->offs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
+ rex->offs[0].end = locinput - reginfo->strbeg;
+ if (reginfo->info_aux_eval->pos_magic)
+ reginfo->info_aux_eval->pos_magic->mg_len
+ = locinput - reginfo->strbeg;
if (sv_yes_mark) {
SV *sv_mrk = get_sv("REGMARK", 1);
/* we don't use MULTICALL here as we want to call the
* first op of the block of interest, rather than the
* first op of the sub */
- before = SP;
+ before = (IV)(SP-PL_stack_base);
PL_op = nop;
CALLRUNOPS(aTHX); /* Scalar context. */
SPAGAIN;
- if (SP == before)
+ if ((IV)(SP-PL_stack_base) == before)
ret = &PL_sv_undef; /* protect against empty (?{}) blocks. */
else {
ret = POPs;
}
- Copy(&saved_state, &PL_reg_state, 1, struct re_save_state);
-
/* *** Note that at this point we don't restore
* PL_comppad, (or pop the CxSUB) on the assumption it may
* be used again soon. This is safe as long as nothing
* in the regexp code uses the pad ! */
PL_op = oop;
PL_curcop = ocurcop;
- PL_regeol = saved_regeol;
- S_regcp_restore(aTHX_ rex, runops_cp);
+ S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen);
if (logical != 2)
break;
}
else {
U32 pm_flags = 0;
- const I32 osize = PL_regsize;
if (SvUTF8(ret) && IN_BYTES) {
/* In use 'bytes': make a copy of the octet
scalar. */
sv_magic(ret, MUTABLE_SV(re_sv), PERL_MAGIC_qr, 0, 0);
}
- PL_regsize = osize;
/* safe to do now that any $1 etc has been
* interpolated into the new pattern string and
* compiled */
- S_regcp_restore(aTHX_ rex, runops_cp);
+ S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen);
}
- re = (struct regexp *)SvANY(re_sv);
+ SAVEFREESV(re_sv);
+ re = ReANY(re_sv);
}
RXp_MATCH_COPIED_off(re);
re->subbeg = rex->subbeg;
re->subcoffset = rex->subcoffset;
rei = RXi_GET(re);
DEBUG_EXECUTE_r(
- debug_start_match(re_sv, utf8_target, locinput, PL_regeol,
- "Matching embedded");
+ debug_start_match(re_sv, utf8_target, locinput,
+ reginfo->strend, "Matching embedded");
);
startpoint = rei->program + 1;
ST.close_paren = 0; /* only used for GOSUB */
eval_recurse_doit: /* Share code with GOSUB below this line */
/* run the pattern returned from (??{...}) */
- ST.cp = regcppush(rex, 0); /* Save *all* the positions. */
+
+ /* Save *all* the positions. */
+ ST.cp = regcppush(rex, 0, maxopenparen);
REGCP_SET(ST.lastcp);
re->lastparen = 0;
re->lastcloseparen = 0;
- PL_regsize = 0;
+ maxopenparen = 0;
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
+ /* invalidate the S-L poscache. We're now executing a
+ * different set of WHILEM ops (and their associated
+ * indexes) against the same string, so the bits in the
+ * cache are meaningless. Setting maxiter to zero forces
+ * the cache to be invalidated and zeroed before reuse.
+ * XXX This is too dramatic a measure. Ideally we should
+ * save the old cache and restore when running the outer
+ * pattern again */
+ reginfo->poscache_maxiter = 0;
- ST.toggle_reg_flags = PL_reg_flags;
- if (RX_UTF8(re_sv))
- PL_reg_flags |= RF_utf8;
- else
- PL_reg_flags &= ~RF_utf8;
- ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
+ is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(re_sv));
ST.prev_rex = rex_sv;
ST.prev_curlyx = cur_curlyx;
case EVAL_AB: /* cleanup after a successful (??{A})B */
/* note: this is called twice; first after popping B, then A */
- PL_reg_flags ^= ST.toggle_reg_flags;
rex_sv = ST.prev_rex;
+ is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
SET_reg_curpm(rex_sv);
- rex = (struct regexp *)SvANY(rex_sv);
+ rex = ReANY(rex_sv);
rexi = RXi_GET(rex);
regcpblow(ST.cp);
cur_eval = ST.prev_eval;
cur_curlyx = ST.prev_curlyx;
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
+ /* Invalidate cache. See "invalidate" comment above. */
+ reginfo->poscache_maxiter = 0;
if ( nochange_depth )
nochange_depth--;
sayYES;
case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
/* note: this is called twice; first after popping B, then A */
- PL_reg_flags ^= ST.toggle_reg_flags;
rex_sv = ST.prev_rex;
+ is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
SET_reg_curpm(rex_sv);
- rex = (struct regexp *)SvANY(rex_sv);
+ rex = ReANY(rex_sv);
rexi = RXi_GET(rex);
REGCP_UNWIND(ST.lastcp);
- regcppop(rex);
+ regcppop(rex, &maxopenparen);
cur_eval = ST.prev_eval;
cur_curlyx = ST.prev_curlyx;
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
+ /* Invalidate cache. See "invalidate" comment above. */
+ reginfo->poscache_maxiter = 0;
if ( nochange_depth )
nochange_depth--;
sayNO_SILENT;
case OPEN: /* ( */
n = ARG(scan); /* which paren pair */
- rex->offs[n].start_tmp = locinput - PL_bostr;
- if (n > PL_regsize)
- PL_regsize = n;
+ rex->offs[n].start_tmp = locinput - reginfo->strbeg;
+ if (n > maxopenparen)
+ maxopenparen = n;
DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
- "rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf" tmp; regsize=%"UVuf"\n",
+ "rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf" tmp; maxopenparen=%"UVuf"\n",
PTR2UV(rex),
PTR2UV(rex->offs),
(UV)n,
(IV)rex->offs[n].start_tmp,
- (UV)PL_regsize
+ (UV)maxopenparen
));
lastopen = n;
break;
/* XXX really need to log other places start/end are set too */
#define CLOSE_CAPTURE \
rex->offs[n].start = rex->offs[n].start_tmp; \
- rex->offs[n].end = locinput - PL_bostr; \
+ rex->offs[n].end = locinput - reginfo->strbeg; \
DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log, \
"rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf"..%"IVdf"\n", \
PTR2UV(rex), \
case CLOSE: /* ) */
n = ARG(scan); /* which paren pair */
CLOSE_CAPTURE;
- /*if (n > PL_regsize)
- PL_regsize = n;*/
if (n > rex->lastparen)
rex->lastparen = n;
rex->lastcloseparen = n;
n = ARG(cursor);
if ( n <= lastopen ) {
CLOSE_CAPTURE;
- /*if (n > PL_regsize)
- PL_regsize = n;*/
if (n > rex->lastparen)
rex->lastparen = n;
rex->lastcloseparen = n;
break;
case IFTHEN: /* (?(cond)A|B) */
- PL_reg_leftiter = PL_reg_maxiter; /* Void cache */
+ reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
if (sw)
next = NEXTOPER(NEXTOPER(scan));
else {
next += ARG(next);
/* XXXX Probably it is better to teach regpush to support
- parenfloor > PL_regsize... */
+ parenfloor > maxopenparen ... */
if (parenfloor > (I32)rex->lastparen)
parenfloor = rex->lastparen; /* Pessimization... */
/* First just match a string of min A's. */
if (n < min) {
- ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor);
+ ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
+ maxopenparen);
cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(ST.lastcp);
goto do_whilem_B_max;
}
- /* super-linear cache processing */
+ /* super-linear cache processing.
+ *
+ * The idea here is that for certain types of CURLYX/WHILEM -
+ * principally those whose upper bound is infinity (and
+ * excluding regexes that have things like \1 and other very
+ * non-regular expresssiony things), then if a pattern like
+ * /....A*.../ fails and we backtrack to the WHILEM, then we
+ * make a note that this particular WHILEM op was at string
+ * position 47 (say) when the rest of pattern failed. Then, if
+ * we ever find ourselves back at that WHILEM, and at string
+ * position 47 again, we can just fail immediately rather than
+ * running the rest of the pattern again.
+ *
+ * This is very handy when patterns start to go
+ * 'super-linear', like in (a+)*(a+)*(a+)*, where you end up
+ * with a combinatorial explosion of backtracking.
+ *
+ * The cache is implemented as a bit array, with one bit per
+ * string byte position per WHILEM op (up to 16) - so its
+ * between 0.25 and 2x the string size.
+ *
+ * To avoid allocating a poscache buffer every time, we do an
+ * initially countdown; only after we have executed a WHILEM
+ * op (string-length x #WHILEMs) times do we allocate the
+ * cache.
+ *
+ * The top 4 bits of scan->flags byte say how many different
+ * relevant CURLLYX/WHILEM op pairs there are, while the
+ * bottom 4-bits is the identifying index number of this
+ * WHILEM.
+ */
if (scan->flags) {
- if (!PL_reg_maxiter) {
+ if (!reginfo->poscache_maxiter) {
/* start the countdown: Postpone detection until we
* know the match is not *that* much linear. */
- PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
+ reginfo->poscache_maxiter
+ = (reginfo->strend - reginfo->strbeg + 1)
+ * (scan->flags>>4);
/* possible overflow for long strings and many CURLYX's */
- if (PL_reg_maxiter < 0)
- PL_reg_maxiter = I32_MAX;
- PL_reg_leftiter = PL_reg_maxiter;
+ if (reginfo->poscache_maxiter < 0)
+ reginfo->poscache_maxiter = I32_MAX;
+ reginfo->poscache_iter = reginfo->poscache_maxiter;
}
- if (PL_reg_leftiter-- == 0) {
+ if (reginfo->poscache_iter-- == 0) {
/* initialise cache */
- const I32 size = (PL_reg_maxiter + 7)/8;
- if (PL_reg_poscache) {
- if ((I32)PL_reg_poscache_size < size) {
- Renew(PL_reg_poscache, size, char);
- PL_reg_poscache_size = size;
+ const I32 size = (reginfo->poscache_maxiter + 7)/8;
+ regmatch_info_aux *const aux = reginfo->info_aux;
+ if (aux->poscache) {
+ if ((I32)reginfo->poscache_size < size) {
+ Renew(aux->poscache, size, char);
+ reginfo->poscache_size = size;
}
- Zero(PL_reg_poscache, size, char);
+ Zero(aux->poscache, size, char);
}
else {
- PL_reg_poscache_size = size;
- Newxz(PL_reg_poscache, size, char);
+ reginfo->poscache_size = size;
+ Newxz(aux->poscache, size, char);
}
DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
"%swhilem: Detected a super-linear match, switching on caching%s...\n",
);
}
- if (PL_reg_leftiter < 0) {
+ if (reginfo->poscache_iter < 0) {
/* have we already failed at this position? */
I32 offset, mask;
offset = (scan->flags & 0xf) - 1
- + (locinput - PL_bostr) * (scan->flags>>4);
+ + (locinput - reginfo->strbeg)
+ * (scan->flags>>4);
mask = 1 << (offset % 8);
offset /= 8;
- if (PL_reg_poscache[offset] & mask) {
+ if (reginfo->info_aux->poscache[offset] & mask) {
DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
"%*s whilem: (cache) already tried at this position...\n",
REPORT_CODE_OFF+depth*2, "")
if (cur_curlyx->u.curlyx.minmod) {
ST.save_curlyx = cur_curlyx;
cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
- ST.cp = regcppush(rex, ST.save_curlyx->u.curlyx.parenfloor);
+ ST.cp = regcppush(rex, ST.save_curlyx->u.curlyx.parenfloor,
+ maxopenparen);
REGCP_SET(ST.lastcp);
PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
locinput);
/* Prefer A over B for maximal matching. */
if (n < max) { /* More greed allowed? */
- ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor);
+ ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
+ maxopenparen);
cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_max, A, locinput);
/* FALL THROUGH */
case WHILEM_A_pre_fail: /* just failed to match even minimal A */
REGCP_UNWIND(ST.lastcp);
- regcppop(rex);
+ regcppop(rex, &maxopenparen);
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
REGCP_UNWIND(ST.lastcp);
- regcppop(rex); /* Restore some previous $<digit>s? */
+ regcppop(rex, &maxopenparen); /* Restore some previous $<digit>s? */
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
"%*s whilem: failed, trying continuation...\n",
REPORT_CODE_OFF+depth*2, "")
do_whilem_B_max:
if (cur_curlyx->u.curlyx.count >= REG_INFTY
&& ckWARN(WARN_REGEXP)
- && !(PL_reg_flags & RF_warned))
+ && !reginfo->warned)
{
- PL_reg_flags |= RF_warned;
+ reginfo->warned = TRUE;
Perl_warner(aTHX_ packWARN(WARN_REGEXP),
"Complex regular subexpression recursion limit (%d) "
"exceeded",
case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
cur_curlyx = ST.save_curlyx;
REGCP_UNWIND(ST.lastcp);
- regcppop(rex);
+ regcppop(rex, &maxopenparen);
if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) {
/* Maximum greed exceeded */
if (cur_curlyx->u.curlyx.count >= REG_INFTY
&& ckWARN(WARN_REGEXP)
- && !(PL_reg_flags & RF_warned))
+ && !reginfo->warned)
{
- PL_reg_flags |= RF_warned;
+ reginfo->warned = TRUE;
Perl_warner(aTHX_ packWARN(WARN_REGEXP),
"Complex regular subexpression recursion "
"limit (%d) exceeded",
);
/* Try grabbing another A and see if it helps. */
cur_curlyx->u.curlyx.lastloc = locinput;
- ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor);
+ ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
+ maxopenparen);
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_min,
/*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
/* if paren positive, emulate an OPEN/CLOSE around A */
if (ST.me->flags) {
U32 paren = ST.me->flags;
- if (paren > PL_regsize)
- PL_regsize = paren;
+ if (paren > maxopenparen)
+ maxopenparen = paren;
scan += NEXT_OFF(scan); /* Skip former OPEN. */
}
ST.A = scan;
ST.count++;
/* after first match, determine A's length: u.curlym.alen */
if (ST.count == 1) {
- if (PL_reg_match_utf8) {
+ if (reginfo->is_utf8_target) {
char *s = st->locinput;
while (s < locinput) {
ST.alen++;
IS_TEXT and friends need to change.
*/
if (PL_regkind[OP(text_node)] == EXACT) {
- if (! S_setup_EXACTISH_ST_c1_c2(aTHX_ text_node,
- &ST.c1, &ST.c2))
+ if (! S_setup_EXACTISH_ST_c1_c2(aTHX_
+ text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8,
+ reginfo))
{
sayNO;
}
"", (IV)ST.count)
);
if (! NEXTCHR_IS_EOS && ST.c1 != CHRTEST_VOID) {
- const UV c = (utf8_target)
- ? utf8n_to_uvchr((U8*)locinput,
- UTF8_MAXBYTES, NULL,
- uniflags)
- : nextchr;
- if (c != (UV) ST.c1 && c != (UV) ST.c2) {
+ if (! UTF8_IS_INVARIANT(nextchr) && utf8_target) {
+ if (memNE(locinput, ST.c1_utf8, UTF8SKIP(locinput))
+ && memNE(locinput, ST.c2_utf8, UTF8SKIP(locinput)))
+ {
+ /* simulate B failing */
+ DEBUG_OPTIMISE_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s CURLYM Fast bail next target=U+%"UVXf" c1=U+%"UVXf" c2=U+%"UVXf"\n",
+ (int)(REPORT_CODE_OFF+(depth*2)),"",
+ valid_utf8_to_uvchr((U8 *) locinput, NULL),
+ valid_utf8_to_uvchr(ST.c1_utf8, NULL),
+ valid_utf8_to_uvchr(ST.c2_utf8, NULL))
+ );
+ state_num = CURLYM_B_fail;
+ goto reenter_switch;
+ }
+ }
+ else if (nextchr != ST.c1 && nextchr != ST.c2) {
/* simulate B failing */
DEBUG_OPTIMISE_r(
PerlIO_printf(Perl_debug_log,
- "%*s CURLYM Fast bail c1=%"IVdf" c2=%"IVdf"\n",
+ "%*s CURLYM Fast bail next target=U+%X c1=U+%X c2=U+%X\n",
(int)(REPORT_CODE_OFF+(depth*2)),"",
- (IV)ST.c1,(IV)ST.c2
- ));
+ (int) nextchr, ST.c1, ST.c2)
+ );
state_num = CURLYM_B_fail;
goto reenter_switch;
}
I32 paren = ST.me->flags;
if (ST.count) {
rex->offs[paren].start
- = HOPc(locinput, -ST.alen) - PL_bostr;
- rex->offs[paren].end = locinput - PL_bostr;
+ = HOPc(locinput, -ST.alen) - reginfo->strbeg;
+ rex->offs[paren].end = locinput - reginfo->strbeg;
if ((U32)paren > rex->lastparen)
rex->lastparen = paren;
rex->lastcloseparen = paren;
#define CURLY_SETPAREN(paren, success) \
if (paren) { \
if (success) { \
- rex->offs[paren].start = HOPc(locinput, -1) - PL_bostr; \
- rex->offs[paren].end = locinput - PL_bostr; \
+ rex->offs[paren].start = HOPc(locinput, -1) - reginfo->strbeg; \
+ rex->offs[paren].end = locinput - reginfo->strbeg; \
if (paren > rex->lastparen) \
rex->lastparen = paren; \
rex->lastcloseparen = paren; \
ST.paren = scan->flags; /* Which paren to set */
ST.lastparen = rex->lastparen;
ST.lastcloseparen = rex->lastcloseparen;
- if (ST.paren > PL_regsize)
- PL_regsize = ST.paren;
+ if (ST.paren > maxopenparen)
+ maxopenparen = ST.paren;
ST.min = ARG1(scan); /* min to match */
ST.max = ARG2(scan); /* max to match */
if (cur_eval && cur_eval->u.eval.close_paren &&
if this changes back then the macro for IS_TEXT and
friends need to change. */
- if (! S_setup_EXACTISH_ST_c1_c2(aTHX_ text_node,
- &ST.c1, &ST.c2))
+ if (! S_setup_EXACTISH_ST_c1_c2(aTHX_
+ text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8,
+ reginfo))
{
sayNO;
}
if (minmod) {
char *li = locinput;
minmod = 0;
- if (ST.min && regrepeat(rex, &li, ST.A, ST.min, depth) < ST.min)
+ if (ST.min &&
+ regrepeat(rex, &li, ST.A, reginfo, ST.min, depth)
+ < ST.min)
sayNO;
SET_locinput(li);
ST.count = ST.min;
/* set ST.maxpos to the furthest point along the
* string that could possibly match */
if (ST.max == REG_INFTY) {
- ST.maxpos = PL_regeol - 1;
+ ST.maxpos = reginfo->strend - 1;
if (utf8_target)
while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
ST.maxpos--;
else if (utf8_target) {
int m = ST.max - ST.min;
for (ST.maxpos = locinput;
- m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
+ m >0 && ST.maxpos < reginfo->strend; m--)
ST.maxpos += UTF8SKIP(ST.maxpos);
}
else {
ST.maxpos = locinput + ST.max - ST.min;
- if (ST.maxpos >= PL_regeol)
- ST.maxpos = PL_regeol - 1;
+ if (ST.maxpos >= reginfo->strend)
+ ST.maxpos = reginfo->strend - 1;
}
goto curly_try_B_min_known;
/* avoid taking address of locinput, so it can remain
* a register var */
char *li = locinput;
- ST.count = regrepeat(rex, &li, ST.A, ST.max, depth);
+ ST.count = regrepeat(rex, &li, ST.A, reginfo, ST.max, depth);
if (ST.count < ST.min)
sayNO;
SET_locinput(li);
if (utf8_target) {
n = (ST.oldloc == locinput) ? 0 : 1;
if (ST.c1 == ST.c2) {
- STRLEN len;
/* set n to utf8_distance(oldloc, locinput) */
- while (locinput <= ST.maxpos &&
- utf8n_to_uvchr((U8*)locinput,
- UTF8_MAXBYTES, &len,
- uniflags) != (UV)ST.c1) {
- locinput += len;
+ while (locinput <= ST.maxpos
+ && memNE(locinput, ST.c1_utf8, UTF8SKIP(locinput)))
+ {
+ locinput += UTF8SKIP(locinput);
n++;
}
}
else {
/* set n to utf8_distance(oldloc, locinput) */
- while (locinput <= ST.maxpos) {
- STRLEN len;
- const UV c = utf8n_to_uvchr((U8*)locinput,
- UTF8_MAXBYTES, &len,
- uniflags);
- if (c == (UV)ST.c1 || c == (UV)ST.c2)
- break;
- locinput += len;
+ while (locinput <= ST.maxpos
+ && memNE(locinput, ST.c1_utf8, UTF8SKIP(locinput))
+ && memNE(locinput, ST.c2_utf8, UTF8SKIP(locinput)))
+ {
+ locinput += UTF8SKIP(locinput);
n++;
}
}
* locinput matches */
char *li = ST.oldloc;
ST.count += n;
- if (regrepeat(rex, &li, ST.A, n, depth) < n)
+ if (regrepeat(rex, &li, ST.A, reginfo, n, depth) < n)
sayNO;
assert(n == REG_INFTY || locinput == li);
}
/* failed -- move forward one */
{
char *li = locinput;
- if (!regrepeat(rex, &li, ST.A, 1, depth)) {
+ if (!regrepeat(rex, &li, ST.A, reginfo, 1, depth)) {
sayNO;
}
locinput = li;
goto fake_end;
}
{
- UV c = 0;
- if (ST.c1 != CHRTEST_VOID && locinput < PL_regeol)
- c = utf8_target ? utf8n_to_uvchr((U8*)locinput,
- UTF8_MAXBYTES, 0, uniflags)
- : (UV) UCHARAT(locinput);
+ bool could_match = locinput < reginfo->strend;
+
/* If it could work, try it. */
- if (ST.c1 == CHRTEST_VOID
- || (locinput < PL_regeol &&
- (c == (UV)ST.c1 || c == (UV)ST.c2)))
- {
+ if (ST.c1 != CHRTEST_VOID && could_match) {
+ if (! UTF8_IS_INVARIANT(UCHARAT(locinput)) && utf8_target)
+ {
+ could_match = memEQ(locinput,
+ ST.c1_utf8,
+ UTF8SKIP(locinput))
+ || memEQ(locinput,
+ ST.c2_utf8,
+ UTF8SKIP(locinput));
+ }
+ else {
+ could_match = UCHARAT(locinput) == ST.c1
+ || UCHARAT(locinput) == ST.c2;
+ }
+ }
+ if (ST.c1 == CHRTEST_VOID || could_match) {
CURLY_SETPAREN(ST.paren, ST.count);
PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput);
assert(0); /* NOTREACHED */
fake_end:
if (cur_eval) {
/* we've just finished A in /(??{A})B/; now continue with B */
- st->u.eval.toggle_reg_flags
- = cur_eval->u.eval.toggle_reg_flags;
- PL_reg_flags ^= st->u.eval.toggle_reg_flags;
st->u.eval.prev_rex = rex_sv; /* inner */
- st->u.eval.cp = regcppush(rex, 0); /* Save *all* the positions. */
+
+ /* Save *all* the positions. */
+ st->u.eval.cp = regcppush(rex, 0, maxopenparen);
rex_sv = cur_eval->u.eval.prev_rex;
+ is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
SET_reg_curpm(rex_sv);
- rex = (struct regexp *)SvANY(rex_sv);
+ rex = ReANY(rex_sv);
rexi = RXi_GET(rex);
cur_curlyx = cur_eval->u.eval.prev_curlyx;
/* Restore parens of the outer rex without popping the
* savestack */
- S_regcp_restore(aTHX_ rex, cur_eval->u.eval.lastcp);
+ S_regcp_restore(aTHX_ rex, cur_eval->u.eval.lastcp,
+ &maxopenparen);
st->u.eval.prev_eval = cur_eval;
cur_eval = cur_eval->u.eval.prev_eval;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
"%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
PL_colors[4],
- (long)(locinput - PL_reg_starttry),
- (long)(reginfo->till - PL_reg_starttry),
+ (long)(locinput - startpos),
+ (long)(reginfo->till - startpos),
PL_colors[5]));
sayNO_SILENT; /* Cannot match: too short. */
break;
case COMMIT: /* (*COMMIT) */
- reginfo->cutpoint = PL_regeol;
+ reginfo->cutpoint = reginfo->strend;
/* FALLTHROUGH */
case PRUNE: /* (*PRUNE) */
#undef ST
case LNBREAK: /* \R */
- if ((n=is_LNBREAK_safe(locinput, PL_regeol, utf8_target))) {
+ if ((n=is_LNBREAK_safe(locinput, reginfo->strend, utf8_target))) {
locinput += n;
} else
sayNO;
break;
-#define CASE_CLASS(nAmE) \
- case nAmE: \
- if (NEXTCHR_IS_EOS) \
- sayNO; \
- if ((n=is_##nAmE(locinput,utf8_target))) { \
- locinput += n; \
- } else \
- sayNO; \
- break; \
- case N##nAmE: \
- if (NEXTCHR_IS_EOS) \
- sayNO; \
- if ((n=is_##nAmE(locinput,utf8_target))) { \
- sayNO; \
- } else { \
- locinput += UTF8SKIP(locinput); \
- } \
- break
-
- CASE_CLASS(VERTWS); /* \v \V */
- CASE_CLASS(HORIZWS); /* \h \H */
-#undef CASE_CLASS
-
default:
PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
PTR2UV(scan), OP(scan));
/* this is a point to jump to in order to increment
* locinput by one character */
increment_locinput:
+ assert(!NEXTCHR_IS_EOS);
if (utf8_target) {
locinput += PL_utf8skip[nextchr];
/* locinput is allowed to go 1 char off the end, but not 2+ */
- if (locinput > PL_regeol)
+ if (locinput > reginfo->strend)
sayNO;
}
else
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
PL_colors[4], PL_colors[5]));
- if (PL_reg_state.re_state_eval_setup_done) {
+ if (reginfo->info_aux_eval) {
/* each successfully executed (?{...}) block does the equivalent of
* local $^R = do {...}
* When popping the save stack, all these locals would be undone;
PERL_UNUSED_VAR(SP);
}
- /* clean up; in particular, free all slabs above current one */
- LEAVE_SCOPE(oldsave);
-
- assert(!result || locinput - PL_bostr >= 0);
- return result ? locinput - PL_bostr : -1;
+ assert(!result || locinput - reginfo->strbeg >= 0);
+ return result ? locinput - reginfo->strbeg : -1;
}
/*
- regrepeat - repeatedly match something simple, report how many
*
+ * What 'simple' means is a node which can be the operand of a quantifier like
+ * '+', or {1,3}
+ *
* startposp - pointer a pointer to the start position. This is updated
* to point to the byte following the highest successful
* match.
* p - the regnode to be repeatedly matched against.
- * max - maximum number of characters to match.
+ * reginfo - struct holding match state, such as strend
+ * max - maximum number of things to match.
* depth - (for debugging) backtracking depth.
*/
STATIC I32
-S_regrepeat(pTHX_ const regexp *prog, char **startposp, const regnode *p, I32 max, int depth)
+S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
+ regmatch_info *const reginfo, I32 max, int depth)
{
dVAR;
- char *scan;
+ char *scan; /* Pointer to current position in target string */
I32 c;
- char *loceol = PL_regeol;
- I32 hardcount = 0;
- bool utf8_target = PL_reg_match_utf8;
+ char *loceol = reginfo->strend; /* local version */
+ I32 hardcount = 0; /* How many matches so far */
+ bool utf8_target = reginfo->is_utf8_target;
+ int to_complement = 0; /* Invert the result? */
UV utf8_flags;
+ _char_class_number classnum;
#ifndef DEBUGGING
PERL_UNUSED_ARG(depth);
#endif
scan = *startposp;
if (max == REG_INFTY)
max = I32_MAX;
- else if (max < loceol - scan)
+ else if (! utf8_target && scan + max < loceol)
loceol = scan + max;
+
+ /* Here, for the case of a non-UTF-8 target we have adjusted <loceol> down
+ * to the maximum of how far we should go in it (leaving it set to the real
+ * end, if the maximum permissible would take us beyond that). This allows
+ * us to make the loop exit condition that we haven't gone past <loceol> to
+ * also mean that we haven't exceeded the max permissible count, saving a
+ * test each time through the loop. But it assumes that the OP matches a
+ * single byte, which is true for most of the OPs below when applied to a
+ * non-UTF-8 target. Those relatively few OPs that don't have this
+ * characteristic will have to compensate.
+ *
+ * There is no adjustment for UTF-8 targets, as the number of bytes per
+ * character varies. OPs will have to test both that the count is less
+ * than the max permissible (using <hardcount> to keep track), and that we
+ * are still within the bounds of the string (using <loceol>. A few OPs
+ * match a single byte no matter what the encoding. They can omit the max
+ * test if, for the UTF-8 case, they do the adjustment that was skipped
+ * above.
+ *
+ * Thus, the code above sets things up for the common case; and exceptional
+ * cases need extra work; the common case is to make sure <scan> doesn't
+ * go past <loceol>, and for UTF-8 to also use <hardcount> to make sure the
+ * count doesn't exceed the maximum permissible */
+
switch (OP(p)) {
case REG_ANY:
if (utf8_target) {
- loceol = PL_regeol;
while (scan < loceol && hardcount < max && *scan != '\n') {
scan += UTF8SKIP(scan);
hardcount++;
break;
case SANY:
if (utf8_target) {
- loceol = PL_regeol;
while (scan < loceol && hardcount < max) {
scan += UTF8SKIP(scan);
hardcount++;
else
scan = loceol;
break;
- case CANY:
- scan = loceol;
+ case CANY: /* Move <scan> forward <max> bytes, unless goes off end */
+ if (utf8_target && scan + max < loceol) {
+
+ /* <loceol> hadn't been adjusted in the UTF-8 case */
+ scan += max;
+ }
+ else {
+ scan = loceol;
+ }
break;
case EXACT:
+ assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1);
+
c = (U8)*STRING(p);
- if (! utf8_target || UNI_IS_INVARIANT(c)) {
+ /* Can use a simple loop if the pattern char to match on is invariant
+ * under UTF-8, or both target and pattern aren't UTF-8. Note that we
+ * can use UTF8_IS_INVARIANT() even if the pattern isn't UTF-8, as it's
+ * true iff it doesn't matter if the argument is in UTF-8 or not */
+ if (UTF8_IS_INVARIANT(c) || (! utf8_target && ! reginfo->is_utf8_pat)) {
+ if (utf8_target && loceol - scan > max) {
+ /* We didn't adjust <loceol> because is UTF-8, but ok to do so,
+ * since here, to match at all, 1 char == 1 byte */
+ loceol = scan + max;
+ }
while (scan < loceol && UCHARAT(scan) == c) {
scan++;
}
}
- else if (UTF_PATTERN) {
- STRLEN scan_char_len;
-
- loceol = PL_regeol;
+ else if (reginfo->is_utf8_pat) {
+ if (utf8_target) {
+ STRLEN scan_char_len;
+
+ /* When both target and pattern are UTF-8, we have to do
+ * string EQ */
+ while (hardcount < max
+ && scan < loceol
+ && (scan_char_len = UTF8SKIP(scan)) <= STR_LEN(p)
+ && memEQ(scan, STRING(p), scan_char_len))
+ {
+ scan += scan_char_len;
+ hardcount++;
+ }
+ }
+ else if (! UTF8_IS_ABOVE_LATIN1(c)) {
- while (hardcount < max
- && scan + (scan_char_len = UTF8SKIP(scan)) < loceol
- && scan_char_len <= STR_LEN(p)
- && memEQ(scan, STRING(p), scan_char_len))
- {
- scan += scan_char_len;
- hardcount++;
- }
+ /* Target isn't utf8; convert the character in the UTF-8
+ * pattern to non-UTF8, and do a simple loop */
+ c = TWO_BYTE_UTF8_TO_UNI(c, *(STRING(p) + 1));
+ while (scan < loceol && UCHARAT(scan) == c) {
+ scan++;
+ }
+ } /* else pattern char is above Latin1, can't possibly match the
+ non-UTF-8 target */
}
- else {
+ else {
- /* Here, the string is utf8, the pattern isn't, but <c> is different
- * in utf8 than not, so can't compare them directly. Outside the
- * loop, find the two utf8 bytes that represent c, and then
- * look for those in sequence in the utf8 string */
+ /* Here, the string must be utf8; pattern isn't, and <c> is
+ * different in utf8 than not, so can't compare them directly.
+ * Outside the loop, find the two utf8 bytes that represent c, and
+ * then look for those in sequence in the utf8 string */
U8 high = UTF8_TWO_BYTE_HI(c);
U8 low = UTF8_TWO_BYTE_LO(c);
- loceol = PL_regeol;
while (hardcount < max
&& scan + 1 < loceol
}
}
break;
+
case EXACTFA:
utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
goto do_exactf;
case EXACTFL:
- PL_reg_flags |= RF_tainted;
+ RXp_MATCH_TAINTED_on(prog);
utf8_flags = FOLDEQ_UTF8_LOCALE;
goto do_exactf;
case EXACTFU_SS:
case EXACTFU_TRICKYFOLD:
case EXACTFU:
- utf8_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0;
+ utf8_flags = reginfo->is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0;
- do_exactf:
- c = (U8)*STRING(p);
+ do_exactf: {
+ int c1, c2;
+ U8 c1_utf8[UTF8_MAXBYTES+1], c2_utf8[UTF8_MAXBYTES+1];
- if (utf8_target
- || OP(p) == EXACTFU_SS
- || (UTF_PATTERN && ! UTF8_IS_INVARIANT(c)))
- {
- /* Use full Unicode fold matching */
- char *tmpeol = loceol;
- STRLEN pat_len = (UTF_PATTERN) ? UTF8SKIP(STRING(p)) : 1;
- while (hardcount < max
- && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target,
- STRING(p), NULL, pat_len, cBOOL(UTF_PATTERN), utf8_flags))
- {
- scan = tmpeol;
- tmpeol = loceol;
- hardcount++;
- }
+ assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1);
- /* XXX Note that the above handles properly the German sharp s in
- * the pattern matching ss in the string. But it doesn't handle
- * properly cases where the string contains say 'LIGATURE ff' and
- * the pattern is 'f+'. This would require, say, a new function or
- * revised interface to foldEQ_utf8(), in which the maximum number
- * of characters to match could be passed and it would return how
- * many actually did. This is just one of many cases where
- * multi-char folds don't work properly, and so the fix is being
- * deferred */
- }
- else {
- U8 folded;
-
- /* Here, the string isn't utf8; and either the pattern isn't utf8
- * or c is an invariant, so its utf8ness doesn't affect c. Can
- * just do simple comparisons for exact or fold matching. */
- switch (OP(p)) {
- case EXACTF: folded = PL_fold[c]; break;
- case EXACTFA:
- case EXACTFU_TRICKYFOLD:
- case EXACTFU: folded = PL_fold_latin1[c]; break;
- case EXACTFL: folded = PL_fold_locale[c]; break;
- default: Perl_croak(aTHX_ "panic: Unexpected op %u", OP(p));
- }
- while (scan < loceol &&
- (UCHARAT(scan) == c || UCHARAT(scan) == folded))
- {
- scan++;
- }
+ if (S_setup_EXACTISH_ST_c1_c2(aTHX_ p, &c1, c1_utf8, &c2, c2_utf8,
+ reginfo))
+ {
+ if (c1 == CHRTEST_VOID) {
+ /* Use full Unicode fold matching */
+ char *tmpeol = reginfo->strend;
+ STRLEN pat_len = reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1;
+ while (hardcount < max
+ && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target,
+ STRING(p), NULL, pat_len,
+ reginfo->is_utf8_pat, utf8_flags))
+ {
+ scan = tmpeol;
+ tmpeol = reginfo->strend;
+ hardcount++;
+ }
+ }
+ else if (utf8_target) {
+ if (c1 == c2) {
+ while (scan < loceol
+ && hardcount < max
+ && memEQ(scan, c1_utf8, UTF8SKIP(scan)))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ }
+ else {
+ while (scan < loceol
+ && hardcount < max
+ && (memEQ(scan, c1_utf8, UTF8SKIP(scan))
+ || memEQ(scan, c2_utf8, UTF8SKIP(scan))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ }
+ }
+ else if (c1 == c2) {
+ while (scan < loceol && UCHARAT(scan) == c1) {
+ scan++;
+ }
+ }
+ else {
+ while (scan < loceol &&
+ (UCHARAT(scan) == c1 || UCHARAT(scan) == c2))
+ {
+ scan++;
+ }
+ }
}
break;
- case ANYOFV:
+ }
case ANYOF:
- if (utf8_target || OP(p) == ANYOFV) {
- STRLEN inclasslen;
- loceol = PL_regeol;
- inclasslen = loceol - scan;
+ case ANYOF_WARN_SUPER:
+ if (utf8_target) {
while (hardcount < max
- && ((inclasslen = loceol - scan) > 0)
- && reginclass(prog, p, (U8*)scan, &inclasslen, utf8_target))
+ && scan < loceol
+ && reginclass(prog, p, (U8*)scan, utf8_target))
{
- scan += inclasslen;
+ scan += UTF8SKIP(scan);
hardcount++;
}
} else {
scan++;
}
break;
- case ALNUMU:
- if (utf8_target) {
- utf8_wordchar:
- loceol = PL_regeol;
- LOAD_UTF8_CHARCLASS_ALNUM();
- while (hardcount < max && scan < loceol &&
- swash_fetch(PL_utf8_alnum, (U8*)scan, utf8_target))
+
+ /* The argument (FLAGS) to all the POSIX node types is the class number */
+
+ case NPOSIXL:
+ to_complement = 1;
+ /* FALLTHROUGH */
+
+ case POSIXL:
+ RXp_MATCH_TAINTED_on(prog);
+ if (! utf8_target) {
+ while (scan < loceol && to_complement ^ cBOOL(isFOO_lc(FLAGS(p),
+ *scan)))
{
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && isWORDCHAR_L1((U8) *scan)) {
- scan++;
+ scan++;
}
- }
- break;
- case ALNUM:
- if (utf8_target)
- goto utf8_wordchar;
- while (scan < loceol && isALNUM((U8) *scan)) {
- scan++;
- }
- break;
- case ALNUMA:
- while (scan < loceol && isWORDCHAR_A((U8) *scan)) {
- scan++;
- }
- break;
- case ALNUML:
- PL_reg_flags |= RF_tainted;
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- isALNUM_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
} else {
- while (scan < loceol && isALNUM_LC(*scan))
- scan++;
- }
- break;
- case NALNUMU:
- if (utf8_target) {
-
- utf8_Nwordchar:
-
- loceol = PL_regeol;
- LOAD_UTF8_CHARCLASS_ALNUM();
- while (hardcount < max && scan < loceol &&
- ! swash_fetch(PL_utf8_alnum, (U8*)scan, utf8_target))
+ while (hardcount < max && scan < loceol
+ && to_complement ^ cBOOL(isFOO_utf8_lc(FLAGS(p),
+ (U8 *) scan)))
{
- scan += UTF8SKIP(scan);
+ scan += UTF8SKIP(scan);
hardcount++;
}
- } else {
- while (scan < loceol && ! isWORDCHAR_L1((U8) *scan)) {
- scan++;
- }
- }
- break;
- case NALNUM:
- if (utf8_target)
- goto utf8_Nwordchar;
- while (scan < loceol && ! isALNUM((U8) *scan)) {
- scan++;
}
break;
+ case POSIXD:
+ if (utf8_target) {
+ goto utf8_posix;
+ }
+ /* FALLTHROUGH */
+
case POSIXA:
- while (scan < loceol && _generic_isCC_A((U8) *scan, FLAGS(p))) {
+ if (utf8_target && loceol - scan > max) {
+
+ /* We didn't adjust <loceol> at the beginning of this routine
+ * because is UTF-8, but it is actually ok to do so, since here, to
+ * match, 1 char == 1 byte. */
+ loceol = scan + max;
+ }
+ while (scan < loceol && _generic_isCC_A((U8) *scan, FLAGS(p))) {
scan++;
}
break;
- case NPOSIXA:
- if (utf8_target) {
- while (scan < loceol && ! _generic_isCC_A((U8) *scan, FLAGS(p))) {
- scan += UTF8SKIP(scan);
- }
- }
- else {
- while (scan < loceol && ! _generic_isCC_A((U8) *scan, FLAGS(p))) {
- scan++;
- }
- }
- break;
- case NALNUMA:
- if (utf8_target) {
- while (scan < loceol && ! isWORDCHAR_A((U8) *scan)) {
- scan += UTF8SKIP(scan);
- }
- }
- else {
- while (scan < loceol && ! isWORDCHAR_A((U8) *scan)) {
- scan++;
- }
- }
- break;
- case NALNUML:
- PL_reg_flags |= RF_tainted;
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- !isALNUM_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && !isALNUM_LC(*scan))
- scan++;
- }
- break;
- case SPACEU:
- if (utf8_target) {
- utf8_space:
+ case NPOSIXD:
+ if (utf8_target) {
+ to_complement = 1;
+ goto utf8_posix;
+ }
+ /* FALL THROUGH */
- loceol = PL_regeol;
- LOAD_UTF8_CHARCLASS_SPACE();
- while (hardcount < max && scan < loceol &&
- (*scan == ' ' ||
- swash_fetch(PL_utf8_space,(U8*)scan, utf8_target)))
- {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- break;
- }
- else {
- while (scan < loceol && isSPACE_L1((U8) *scan)) {
+ case NPOSIXA:
+ if (! utf8_target) {
+ while (scan < loceol && ! _generic_isCC_A((U8) *scan, FLAGS(p))) {
scan++;
}
- break;
- }
- case SPACE:
- if (utf8_target)
- goto utf8_space;
+ }
+ else {
- while (scan < loceol && isSPACE((U8) *scan)) {
- scan++;
- }
- break;
- case SPACEA:
- while (scan < loceol && isSPACE_A((U8) *scan)) {
- scan++;
- }
- break;
- case SPACEL:
- PL_reg_flags |= RF_tainted;
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- isSPACE_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
+ /* 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. */
+ while (hardcount < max && scan < loceol
+ && (! UTF8_IS_INVARIANT(*scan)
+ || ! _generic_isCC_A((U8) *scan, FLAGS(p))))
+ {
+ scan += UTF8SKIP(scan);
hardcount++;
}
- } else {
- while (scan < loceol && isSPACE_LC(*scan))
- scan++;
- }
- break;
- case NSPACEU:
- if (utf8_target) {
+ }
+ break;
- utf8_Nspace:
+ case NPOSIXU:
+ to_complement = 1;
+ /* FALLTHROUGH */
- loceol = PL_regeol;
- LOAD_UTF8_CHARCLASS_SPACE();
- while (hardcount < max && scan < loceol &&
- ! (*scan == ' ' ||
- swash_fetch(PL_utf8_space,(U8*)scan, utf8_target)))
+ case POSIXU:
+ if (! utf8_target) {
+ while (scan < loceol && to_complement
+ ^ cBOOL(_generic_isCC((U8) *scan, FLAGS(p))))
{
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- break;
- }
- else {
- while (scan < loceol && ! isSPACE_L1((U8) *scan)) {
scan++;
}
}
- break;
- case NSPACE:
- if (utf8_target)
- goto utf8_Nspace;
-
- while (scan < loceol && ! isSPACE((U8) *scan)) {
- scan++;
- }
- break;
- case NSPACEA:
- if (utf8_target) {
- while (scan < loceol && ! isSPACE_A((U8) *scan)) {
- scan += UTF8SKIP(scan);
- }
- }
- else {
- while (scan < loceol && ! isSPACE_A((U8) *scan)) {
- scan++;
- }
- }
- break;
- case NSPACEL:
- PL_reg_flags |= RF_tainted;
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- !isSPACE_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && !isSPACE_LC(*scan))
- scan++;
- }
- break;
- case DIGIT:
- if (utf8_target) {
- loceol = PL_regeol;
- LOAD_UTF8_CHARCLASS_DIGIT();
- while (hardcount < max && scan < loceol &&
- swash_fetch(PL_utf8_digit, (U8*)scan, utf8_target)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && isDIGIT(*scan))
- scan++;
- }
- break;
- case DIGITA:
- while (scan < loceol && isDIGIT_A((U8) *scan)) {
- scan++;
- }
- break;
- case DIGITL:
- PL_reg_flags |= RF_tainted;
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- isDIGIT_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && isDIGIT_LC(*scan))
- scan++;
- }
- break;
- case NDIGIT:
- if (utf8_target) {
- loceol = PL_regeol;
- LOAD_UTF8_CHARCLASS_DIGIT();
- while (hardcount < max && scan < loceol &&
- !swash_fetch(PL_utf8_digit, (U8*)scan, utf8_target)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && !isDIGIT(*scan))
- scan++;
- }
- break;
- case NDIGITA:
- if (utf8_target) {
- while (scan < loceol && ! isDIGIT_A((U8) *scan)) {
- scan += UTF8SKIP(scan);
- }
- }
else {
- while (scan < loceol && ! isDIGIT_A((U8) *scan)) {
- scan++;
- }
- }
- break;
- case NDIGITL:
- PL_reg_flags |= RF_tainted;
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- !isDIGIT_LC_utf8((U8*)scan)) {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && !isDIGIT_LC(*scan))
- scan++;
+ utf8_posix:
+ classnum = (_char_class_number) FLAGS(p);
+ if (classnum < _FIRST_NON_SWASH_CC) {
+
+ /* Here, a swash is needed for above-Latin1 code points.
+ * Process as many Latin1 code points using the built-in rules.
+ * Go to another loop to finish processing upon encountering
+ * the first Latin1 code point. We could do that in this loop
+ * as well, but the other way saves having to test if the swash
+ * has been loaded every time through the loop: extra space to
+ * save a test. */
+ while (hardcount < max && scan < loceol) {
+ if (UTF8_IS_INVARIANT(*scan)) {
+ if (! (to_complement ^ cBOOL(_generic_isCC((U8) *scan,
+ classnum))))
+ {
+ break;
+ }
+ scan++;
+ }
+ else if (UTF8_IS_DOWNGRADEABLE_START(*scan)) {
+ if (! (to_complement
+ ^ cBOOL(_generic_isCC(TWO_BYTE_UTF8_TO_UNI(*scan,
+ *(scan + 1)),
+ classnum))))
+ {
+ break;
+ }
+ scan += 2;
+ }
+ else {
+ goto found_above_latin1;
+ }
+
+ hardcount++;
+ }
+ }
+ else {
+ /* For these character classes, the knowledge of how to handle
+ * every code point is compiled in to Perl via a macro. This
+ * code is written for making the loops as tight as possible.
+ * It could be refactored to save space instead */
+ switch (classnum) {
+ case _CC_ENUM_SPACE: /* XXX would require separate code
+ if we revert the change of \v
+ matching this */
+ /* FALL THROUGH */
+ case _CC_ENUM_PSXSPC:
+ while (hardcount < max
+ && scan < loceol
+ && (to_complement ^ cBOOL(isSPACE_utf8(scan))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ break;
+ case _CC_ENUM_BLANK:
+ while (hardcount < max
+ && scan < loceol
+ && (to_complement ^ cBOOL(isBLANK_utf8(scan))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ break;
+ case _CC_ENUM_XDIGIT:
+ while (hardcount < max
+ && scan < loceol
+ && (to_complement ^ cBOOL(isXDIGIT_utf8(scan))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ break;
+ case _CC_ENUM_VERTSPACE:
+ while (hardcount < max
+ && scan < loceol
+ && (to_complement ^ cBOOL(isVERTWS_utf8(scan))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ break;
+ case _CC_ENUM_CNTRL:
+ while (hardcount < max
+ && scan < loceol
+ && (to_complement ^ cBOOL(isCNTRL_utf8(scan))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ break;
+ default:
+ Perl_croak(aTHX_ "panic: regrepeat() node %d='%s' has an unexpected character class '%d'", OP(p), PL_reg_name[OP(p)], classnum);
+ }
+ }
}
- break;
+ break;
+
+ found_above_latin1: /* Continuation of POSIXU and NPOSIXU */
+
+ /* Load the swash if not already present */
+ if (! PL_utf8_swash_ptrs[classnum]) {
+ U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
+ PL_utf8_swash_ptrs[classnum] = _core_swash_init(
+ "utf8", swash_property_names[classnum],
+ &PL_sv_undef, 1, 0, NULL, &flags);
+ }
+
+ while (hardcount < max && scan < loceol
+ && to_complement ^ cBOOL(_generic_utf8(
+ classnum,
+ scan,
+ swash_fetch(PL_utf8_swash_ptrs[classnum],
+ (U8 *) scan,
+ TRUE))))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ break;
+
case LNBREAK:
if (utf8_target) {
- loceol = PL_regeol;
while (hardcount < max && scan < loceol &&
(c=is_LNBREAK_utf8_safe(scan, loceol))) {
scan += c;
hardcount++;
}
} else {
- /*
- LNBREAK can match two latin chars, which is ok,
- because we have a null terminated string, but we
- have to use hardcount in this situation
- */
+ /* LNBREAK can match one or two latin chars, which is ok, but we
+ * have to use hardcount in this situation, and throw away the
+ * adjustment to <loceol> done before the switch statement */
+ loceol = reginfo->strend;
while (scan < loceol && (c=is_LNBREAK_latin1_safe(scan, loceol))) {
scan+=c;
hardcount++;
}
- }
- break;
- case HORIZWS:
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- (c=is_HORIZWS_utf8_safe(scan, loceol)))
- {
- scan += c;
- hardcount++;
- }
- } else {
- while (scan < loceol && is_HORIZWS_latin1_safe(scan, loceol))
- scan++;
- }
- break;
- case NHORIZWS:
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- !is_HORIZWS_utf8_safe(scan, loceol))
- {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && !is_HORIZWS_latin1_safe(scan, loceol))
- scan++;
-
- }
+ }
break;
- case VERTWS:
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- (c=is_VERTWS_utf8_safe(scan, loceol)))
- {
- scan += c;
- hardcount++;
- }
- } else {
- while (scan < loceol && is_VERTWS_latin1_safe(scan, loceol))
- scan++;
- }
- break;
- case NVERTWS:
- if (utf8_target) {
- loceol = PL_regeol;
- while (hardcount < max && scan < loceol &&
- !is_VERTWS_utf8_safe(scan, loceol))
- {
- scan += UTF8SKIP(scan);
- hardcount++;
- }
- } else {
- while (scan < loceol && !is_VERTWS_latin1_safe(scan, loceol))
- scan++;
-
- }
- break;
+ case BOUND:
+ case BOUNDA:
+ case BOUNDL:
+ case BOUNDU:
+ case EOS:
+ case GPOS:
+ case KEEPS:
+ case NBOUND:
+ case NBOUNDA:
+ case NBOUNDL:
+ case NBOUNDU:
+ case OPFAIL:
+ case SBOL:
+ case SEOL:
+ /* These are all 0 width, so match right here or not at all. */
+ break;
+
+ default:
+ Perl_croak(aTHX_ "panic: regrepeat() called with unrecognized node type %d='%s'", OP(p), PL_reg_name[OP(p)]);
+ assert(0); /* NOTREACHED */
- default: /* Called on something of 0 width. */
- break; /* So match right here or not at all. */
}
if (hardcount)
#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
/*
- regclass_swash - prepare the utf8 swash. Wraps the shared core version to
-create a copy so that changes the caller makes won't change the shared one
+create a copy so that changes the caller makes won't change the shared one.
+If <altsvp> is non-null, will return NULL in it, for back-compat.
*/
SV *
-Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
+Perl_regclass_swash(pTHX_ const regexp *prog, const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
{
PERL_ARGS_ASSERT_REGCLASS_SWASH;
- return newSVsv(core_regclass_swash(prog, node, doinit, listsvp, altsvp));
+
+ if (altsvp) {
+ *altsvp = NULL;
+ }
+
+ return newSVsv(core_regclass_swash(prog, node, doinit, listsvp));
}
#endif
STATIC SV *
-S_core_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
+S_core_regclass_swash(pTHX_ const regexp *prog, const regnode* node, bool doinit, SV** listsvp)
{
/* Returns the swash for the input 'node' in the regex 'prog'.
* If <doinit> is true, will attempt to create the swash if not already
* done.
* If <listsvp> is non-null, will return the swash initialization string in
* it.
- * If <altsvp> is non-null, will return the alternates to the regular swash
- * in it
* Tied intimately to how regcomp.c sets up the data structure */
dVAR;
SV *sw = NULL;
SV *si = NULL;
- SV *alt = NULL;
SV* invlist = NULL;
RXi_GET_DECL(prog,progi);
si = *ary; /* ary[0] = the string to initialize the swash with */
- /* Elements 3 and 4 are either both present or both absent. [3] is
- * any inversion list generated at compile time; [4] indicates if
+ /* Elements 2 and 3 are either both present or both absent. [2] is
+ * any inversion list generated at compile time; [3] indicates if
* that inversion list has any user-defined properties in it. */
- if (av_len(av) >= 3) {
- invlist = ary[3];
- if (SvUV(ary[4])) {
+ if (av_len(av) >= 2) {
+ invlist = ary[2];
+ if (SvUV(ary[3])) {
swash_init_flags |= _CORE_SWASH_INIT_USER_DEFINED_PROPERTY;
}
}
&swash_init_flags);
(void)av_store(av, 1, sw);
}
-
- /* Element [2] is for any multi-char folds. Note that is a
- * fundamentally flawed design, because can't backtrack and try
- * again. See [perl #89774] */
- if (SvTYPE(ary[2]) == SVt_PVAV) {
- alt = ary[2];
- }
}
}
*listsvp = matches_string;
}
- if (altsvp)
- *altsvp = alt;
-
return sw;
}
n is the ANYOF regnode
p is the target string
- lenp is pointer to the maximum number of bytes of how far to go in p
- (This is assumed wthout checking to always be at least the current
- character's size)
utf8_target tells whether p is in UTF-8.
- Returns true if matched; false otherwise. If lenp is not NULL, on return
- from a successful match, the value it points to will be updated to how many
- bytes in p were matched. If there was no match, the value is undefined,
- possibly changed from the input.
+ Returns true if matched; false otherwise.
Note that this can be a synthetic start class, a combination of various
nodes, so things you think might be mutually exclusive, such as locale,
*/
STATIC bool
-S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, register const U8* const p, STRLEN* lenp, register const bool utf8_target)
+S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const p, const bool utf8_target)
{
dVAR;
const char flags = ANYOF_FLAGS(n);
bool match = FALSE;
UV c = *p;
- STRLEN c_len = 0;
- STRLEN maxlen;
PERL_ARGS_ASSERT_REGINCLASS;
- /* If c is not already the code point, get it */
- if (utf8_target && !UTF8_IS_INVARIANT(c)) {
+ /* If c is not already the code point, get it. Note that
+ * UTF8_IS_INVARIANT() works even if not in UTF-8 */
+ if (! UTF8_IS_INVARIANT(c) && utf8_target) {
+ STRLEN c_len = 0;
c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &c_len,
(UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV)
| UTF8_ALLOW_FFFF | UTF8_CHECK_ONLY);
if (c_len == (STRLEN)-1)
Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
}
- else {
- c_len = 1;
- }
-
- /* Use passed in max length, or one character if none passed in or less
- * than one character. And assume will match just one character. This is
- * overwritten later if matched more. */
- if (lenp) {
- maxlen = (*lenp > c_len) ? *lenp : c_len;
- *lenp = c_len;
-
- }
- else {
- maxlen = c_len;
- }
/* If this character is potentially in the bitmap, check it */
if (c < 256) {
{
match = TRUE;
}
-
else if (flags & ANYOF_LOCALE) {
- PL_reg_flags |= RF_tainted;
+ RXp_MATCH_TAINTED_on(prog);
- if ((flags & ANYOF_LOC_NONBITMAP_FOLD)
+ if ((flags & ANYOF_LOC_FOLD)
&& ANYOF_BITMAP_TEST(n, PL_fold_locale[c]))
{
match = TRUE;
}
- else if (ANYOF_CLASS_TEST_ANY_SET(n) &&
- ((ANYOF_CLASS_TEST(n, ANYOF_ALNUM) && isALNUM_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NALNUM) && !isALNUM_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_SPACE) && isSPACE_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NSPACE) && !isSPACE_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_DIGIT) && isDIGIT_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT) && !isDIGIT_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC) && isALNUMC_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_ALPHA) && isALPHA_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NALPHA) && !isALPHA_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_ASCII) && isASCII_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NASCII) && !isASCII_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_CNTRL) && isCNTRL_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL) && !isCNTRL_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_GRAPH) && isGRAPH_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH) && !isGRAPH_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_LOWER) && isLOWER_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NLOWER) && !isLOWER_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_PRINT) && isPRINT_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NPRINT) && !isPRINT_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_PUNCT) && isPUNCT_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT) && !isPUNCT_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_UPPER) && isUPPER_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NUPPER) && !isUPPER_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT) && isXDIGIT(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC) && isPSXSPC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_BLANK) && isBLANK_LC(c)) ||
- (ANYOF_CLASS_TEST(n, ANYOF_NBLANK) && !isBLANK_LC(c))
- ) /* How's that for a conditional? */
- ) {
- match = TRUE;
+ else if (ANYOF_CLASS_TEST_ANY_SET(n)) {
+
+ /* The data structure is arranged so bits 0, 2, 4, ... are set
+ * if the class includes the Posix character class given by
+ * bit/2; and 1, 3, 5, ... are set if the class includes the
+ * complemented Posix class given by int(bit/2). So we loop
+ * through the bits, each time changing whether we complement
+ * the result or not. Suppose for the sake of illustration
+ * that bits 0-3 mean respectively, \w, \W, \s, \S. If bit 0
+ * is set, it means there is a match for this ANYOF node if the
+ * character is in the class given by the expression (0 / 2 = 0
+ * = \w). If it is in that class, isFOO_lc() will return 1,
+ * and since 'to_complement' is 0, the result will stay TRUE,
+ * and we exit the loop. Suppose instead that bit 0 is 0, but
+ * bit 1 is 1. That means there is a match if the character
+ * matches \W. We won't bother to call isFOO_lc() on bit 0,
+ * but will on bit 1. On the second iteration 'to_complement'
+ * will be 1, so the exclusive or will reverse things, so we
+ * are testing for \W. On the third iteration, 'to_complement'
+ * will be 0, and we would be testing for \s; the fourth
+ * iteration would test for \S, etc.
+ *
+ * Note that this code assumes that all the classes are closed
+ * under folding. For example, if a character matches \w, then
+ * its fold does too; and vice versa. This should be true for
+ * any well-behaved locale for all the currently defined Posix
+ * classes, except for :lower: and :upper:, which are handled
+ * by the pseudo-class :cased: which matches if either of the
+ * other two does. To get rid of this assumption, an outer
+ * loop could be used below to iterate over both the source
+ * character, and its fold (if different) */
+
+ int count = 0;
+ int to_complement = 0;
+ while (count < ANYOF_MAX) {
+ if (ANYOF_CLASS_TEST(n, count)
+ && to_complement ^ cBOOL(isFOO_lc(count/2, (U8) c)))
+ {
+ match = TRUE;
+ break;
+ }
+ count++;
+ to_complement ^= 1;
+ }
}
}
}
/* If the bitmap didn't (or couldn't) match, and something outside the
- * bitmap could match, try that. Locale nodes specifiy completely the
+ * bitmap could match, try that. Locale nodes specify completely the
* behavior of code points in the bit map (otherwise, a utf8 target would
* cause them to be treated as Unicode and not locale), except in
* the very unlikely event when this node is a synthetic start class, which
|| (utf8_target
&& (c >=256
|| (! (flags & ANYOF_LOCALE))
- || (flags & ANYOF_IS_SYNTHETIC)))))
+ || OP(n) == ANYOF_SYNTHETIC))))
{
- AV *av;
- SV * const sw = core_regclass_swash(prog, n, TRUE, 0, (SV**)&av);
-
+ SV * const sw = core_regclass_swash(prog, n, TRUE, 0);
if (sw) {
U8 * utf8_p;
if (utf8_target) {
utf8_p = (U8 *) p;
- } else {
-
- /* Not utf8. Convert as much of the string as available up
- * to the limit of how far the (single) character in the
- * pattern can possibly match (no need to go further). If
- * the node is a straight ANYOF or not folding, it can't
- * match more than one. Otherwise, It can match up to how
- * far a single char can fold to. Since not utf8, each
- * character is a single byte, so the max it can be in
- * bytes is the same as the max it can be in characters */
- STRLEN len = (OP(n) == ANYOF
- || ! (flags & ANYOF_LOC_NONBITMAP_FOLD))
- ? 1
- : (maxlen < UTF8_MAX_FOLD_CHAR_EXPAND)
- ? maxlen
- : UTF8_MAX_FOLD_CHAR_EXPAND;
+ } else { /* Convert to utf8 */
+ STRLEN len = 1;
utf8_p = bytes_to_utf8(p, &len);
}
- if (swash_fetch(sw, utf8_p, TRUE))
+ if (swash_fetch(sw, utf8_p, TRUE)) {
match = TRUE;
- else if (flags & ANYOF_LOC_NONBITMAP_FOLD) {
-
- /* Here, we need to test if the fold of the target string
- * matches. The non-multi char folds have all been moved to
- * the compilation phase, and the multi-char folds have
- * been stored by regcomp into 'av'; we linearly check to
- * see if any match the target string (folded). We know
- * that the originals were each one character, but we don't
- * currently know how many characters/bytes each folded to,
- * except we do know that there are small limits imposed by
- * Unicode. XXX A performance enhancement would be to have
- * regcomp.c store the max number of chars/bytes that are
- * in an av entry, as, say the 0th element. Even better
- * would be to have a hash of the few characters that can
- * start a multi-char fold to the max number of chars of
- * those folds.
- *
- * If there is a match, we will need to advance (if lenp is
- * specified) the match pointer in the target string. But
- * what we are comparing here isn't that string directly,
- * but its fold, whose length may differ from the original.
- * As we go along in constructing the fold, therefore, we
- * create a map so that we know how many bytes in the
- * source to advance given that we have matched a certain
- * number of bytes in the fold. This map is stored in
- * 'map_fold_len_back'. Let n mean the number of bytes in
- * the fold of the first character that we are folding.
- * Then map_fold_len_back[n] is set to the number of bytes
- * in that first character. Similarly let m be the
- * corresponding number for the second character to be
- * folded. Then map_fold_len_back[n+m] is set to the
- * number of bytes occupied by the first two source
- * characters. ... */
- U8 map_fold_len_back[UTF8_MAXBYTES_CASE+1] = { 0 };
- U8 folded[UTF8_MAXBYTES_CASE+1];
- STRLEN foldlen = 0; /* num bytes in fold of 1st char */
- STRLEN total_foldlen = 0; /* num bytes in fold of all
- chars */
-
- if (OP(n) == ANYOF || maxlen == 1 || ! lenp || ! av) {
-
- /* Here, only need to fold the first char of the target
- * string. It the source wasn't utf8, is 1 byte long */
- to_utf8_fold(utf8_p, folded, &foldlen);
- total_foldlen = foldlen;
- map_fold_len_back[foldlen] = (utf8_target)
- ? UTF8SKIP(utf8_p)
- : 1;
- }
- else {
-
- /* Here, need to fold more than the first char. Do so
- * up to the limits */
- U8* source_ptr = utf8_p; /* The source for the fold
- is the regex target
- string */
- U8* folded_ptr = folded;
- U8* e = utf8_p + maxlen; /* Can't go beyond last
- available byte in the
- target string */
- U8 i;
- for (i = 0;
- i < UTF8_MAX_FOLD_CHAR_EXPAND && source_ptr < e;
- i++)
- {
-
- /* Fold the next character */
- U8 this_char_folded[UTF8_MAXBYTES_CASE+1];
- STRLEN this_char_foldlen;
- to_utf8_fold(source_ptr,
- this_char_folded,
- &this_char_foldlen);
-
- /* Bail if it would exceed the byte limit for
- * folding a single char. */
- if (this_char_foldlen + folded_ptr - folded >
- UTF8_MAXBYTES_CASE)
- {
- break;
- }
-
- /* Add the fold of this character */
- Copy(this_char_folded,
- folded_ptr,
- this_char_foldlen,
- U8);
- source_ptr += UTF8SKIP(source_ptr);
- folded_ptr += this_char_foldlen;
- total_foldlen = folded_ptr - folded;
-
- /* Create map from the number of bytes in the fold
- * back to the number of bytes in the source. If
- * the source isn't utf8, the byte count is just
- * the number of characters so far */
- map_fold_len_back[total_foldlen]
- = (utf8_target)
- ? source_ptr - utf8_p
- : i + 1;
- }
- *folded_ptr = '\0';
- }
-
-
- /* Do the linear search to see if the fold is in the list
- * of multi-char folds. */
- if (av) {
- I32 i;
- for (i = 0; i <= av_len(av); i++) {
- SV* const sv = *av_fetch(av, i, FALSE);
- STRLEN len;
- const char * const s = SvPV_const(sv, len);
-
- if (len <= total_foldlen
- && memEQ(s, (char*)folded, len)
-
- /* If 0, means matched a partial char. See
- * [perl #90536] */
- && map_fold_len_back[len])
- {
-
- /* Advance the target string ptr to account for
- * this fold, but have to translate from the
- * folded length to the corresponding source
- * length. */
- if (lenp) {
- *lenp = map_fold_len_back[len];
- }
- match = TRUE;
- break;
- }
- }
- }
- }
+ }
/* If we allocated a string above, free it */
if (! utf8_target) Safefree(utf8_p);
}
if (UNICODE_IS_SUPER(c)
- && (flags & ANYOF_WARN_SUPER)
+ && OP(n) == ANYOF_WARN_SUPER
&& ckWARN_d(WARN_NON_UNICODE))
{
Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
return s;
}
+
+/* when executing a regex that may have (?{}), extra stuff needs setting
+ up that will be visible to the called code, even before the current
+ match has finished. In particular:
+
+ * $_ is localised to the SV currently being matched;
+ * pos($_) is created if necessary, ready to be updated on each call-out
+ to code;
+ * a fake PMOP is created that can be set to PL_curpm (normally PL_curpm
+ isn't set until the current pattern is successfully finished), so that
+ $1 etc of the match-so-far can be seen;
+ * save the old values of subbeg etc of the current regex, and set then
+ to the current string (again, this is normally only done at the end
+ of execution)
+*/
+
static void
-restore_pos(pTHX_ void *arg)
+S_setup_eval_state(pTHX_ regmatch_info *const reginfo)
{
- dVAR;
- regexp * const rex = (regexp *)arg;
- if (PL_reg_state.re_state_eval_setup_done) {
- if (PL_reg_oldsaved) {
- rex->subbeg = PL_reg_oldsaved;
- rex->sublen = PL_reg_oldsavedlen;
- rex->suboffset = PL_reg_oldsavedoffset;
- rex->subcoffset = PL_reg_oldsavedcoffset;
+ MAGIC *mg;
+ regexp *const rex = ReANY(reginfo->prog);
+ regmatch_info_aux_eval *eval_state = reginfo->info_aux_eval;
+
+ eval_state->rex = rex;
+
+ if (reginfo->sv) {
+ /* Make $_ available to executed code. */
+ if (reginfo->sv != DEFSV) {
+ SAVE_DEFSV;
+ DEFSV_set(reginfo->sv);
+ }
+
+ if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
+ && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
+ /* prepare for quick setting of pos */
#ifdef PERL_OLD_COPY_ON_WRITE
- rex->saved_copy = PL_nrs;
+ if (SvIsCOW(reginfo->sv))
+ sv_force_normal_flags(reginfo->sv, 0);
#endif
- RXp_MATCH_COPIED_on(rex);
- }
- PL_reg_magic->mg_len = PL_reg_oldpos;
- PL_reg_state.re_state_eval_setup_done = FALSE;
- PL_curpm = PL_reg_oldcurpm;
- }
+ mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, NULL, 0);
+ mg->mg_len = -1;
+ }
+ eval_state->pos_magic = mg;
+ eval_state->pos = mg->mg_len;
+ }
+ else
+ eval_state->pos_magic = NULL;
+
+ if (!PL_reg_curpm) {
+ /* PL_reg_curpm is a fake PMOP that we can attach the current
+ * regex to and point PL_curpm at, so that $1 et al are visible
+ * within a /(?{})/. It's just allocated once per interpreter the
+ * first time its needed */
+ Newxz(PL_reg_curpm, 1, PMOP);
+#ifdef USE_ITHREADS
+ {
+ SV* const repointer = &PL_sv_undef;
+ /* this regexp is also owned by the new PL_reg_curpm, which
+ will try to free it. */
+ av_push(PL_regex_padav, repointer);
+ PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
+ PL_regex_pad = AvARRAY(PL_regex_padav);
+ }
+#endif
+ }
+ SET_reg_curpm(reginfo->prog);
+ eval_state->curpm = PL_curpm;
+ PL_curpm = PL_reg_curpm;
+ if (RXp_MATCH_COPIED(rex)) {
+ /* Here is a serious problem: we cannot rewrite subbeg,
+ since it may be needed if this match fails. Thus
+ $` inside (?{}) could fail... */
+ eval_state->subbeg = rex->subbeg;
+ eval_state->sublen = rex->sublen;
+ eval_state->suboffset = rex->suboffset;
+ eval_state->subcoffset = rex->subcoffset;
+#ifdef PERL_ANY_COW
+ eval_state->saved_copy = rex->saved_copy;
+#endif
+ RXp_MATCH_COPIED_off(rex);
+ }
+ else
+ eval_state->subbeg = NULL;
+ rex->subbeg = (char *)reginfo->strbeg;
+ rex->suboffset = 0;
+ rex->subcoffset = 0;
+ rex->sublen = reginfo->strend - reginfo->strbeg;
}
+
+/* destructor to clear up regmatch_info_aux and regmatch_info_aux_eval */
+
+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;
+
+ Safefree(aux->poscache);
+
+ if (eval_state) {
+
+ /* undo the effects of S_setup_eval_state() */
+
+ if (eval_state->subbeg) {
+ regexp * const rex = eval_state->rex;
+ rex->subbeg = eval_state->subbeg;
+ rex->sublen = eval_state->sublen;
+ rex->suboffset = eval_state->suboffset;
+ rex->subcoffset = eval_state->subcoffset;
+#ifdef PERL_ANY_COW
+ rex->saved_copy = eval_state->saved_copy;
+#endif
+ RXp_MATCH_COPIED_on(rex);
+ }
+ if (eval_state->pos_magic)
+ eval_state->pos_magic->mg_len = eval_state->pos;
+
+ PL_curpm = eval_state->curpm;
+ }
+
+ PL_regmatch_state = aux->old_regmatch_state;
+ PL_regmatch_slab = aux->old_regmatch_slab;
+
+ /* free all slabs above current one - this must be the last action
+ * of this function, as aux and eval_state are allocated within
+ * slabs and may be freed here */
+
+ s = PL_regmatch_slab->next;
+ if (s) {
+ PL_regmatch_slab->next = NULL;
+ while (s) {
+ regmatch_slab * const osl = s;
+ s = s->next;
+ Safefree(osl);
+ }
+ }
+}
+
+
STATIC void
-S_to_utf8_substr(pTHX_ register regexp *prog)
+S_to_utf8_substr(pTHX_ regexp *prog)
{
/* Converts substr fields in prog from bytes to UTF-8, calling fbm_compile
* on the converted value */
}
STATIC bool
-S_to_byte_substr(pTHX_ register regexp *prog)
+S_to_byte_substr(pTHX_ regexp *prog)
{
/* Converts substr fields in prog from UTF-8 to bytes, calling fbm_compile
* on the converted value; returns FALSE if can't be converted. */
return TRUE;
}
-/* These constants are for finding GCB=LV and GCB=LVT. These are for the
- * pre-composed Hangul syllables, which are all in a contiguous block and
- * arranged there in such a way so as to facilitate alorithmic determination of
- * their characteristics. As such, they don't need a swash, but can be
- * determined by simple arithmetic. Almost all are GCB=LVT, but every 28th one
- * is a GCB=LV */
-#define SBASE 0xAC00 /* Start of block */
-#define SCount 11172 /* Length of block */
-#define TCount 28
-
-#if 0 /* This routine is not currently used */
-PERL_STATIC_INLINE bool
-S_is_utf8_X_LV(pTHX_ const U8 *p)
-{
- /* Unlike most other similarly named routines here, this does not create a
- * swash, so swash_fetch() cannot be used on PL_utf8_X_LV. */
-
- dVAR;
-
- UV cp = valid_utf8_to_uvchr(p, NULL);
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LV;
-
- /* The earliest Unicode releases did not have these precomposed Hangul
- * syllables. Set to point to undef in that case, so will return false on
- * every call */
- if (! PL_utf8_X_LV) { /* Set up if this is the first time called */
- PL_utf8_X_LV = swash_init("utf8", "_X_GCB_LV", &PL_sv_undef, 1, 0);
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_LV)) == 0) {
- SvREFCNT_dec(PL_utf8_X_LV);
- PL_utf8_X_LV = &PL_sv_undef;
- }
- }
-
- return (PL_utf8_X_LV != &PL_sv_undef
- && cp >= SBASE && cp < SBASE + SCount
- && (cp - SBASE) % TCount == 0); /* Only every TCount one is LV */
-}
-#endif
-
-PERL_STATIC_INLINE bool
-S_is_utf8_X_LVT(pTHX_ const U8 *p)
-{
- /* Unlike most other similarly named routines here, this does not create a
- * swash, so swash_fetch() cannot be used on PL_utf8_X_LVT. */
-
- dVAR;
-
- UV cp = valid_utf8_to_uvchr(p, NULL);
-
- PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
-
- /* The earliest Unicode releases did not have these precomposed Hangul
- * syllables. Set to point to undef in that case, so will return false on
- * every call */
- if (! PL_utf8_X_LVT) { /* Set up if this is the first time called */
- PL_utf8_X_LVT = swash_init("utf8", "_X_GCB_LVT", &PL_sv_undef, 1, 0);
- if (_invlist_len(_get_swash_invlist(PL_utf8_X_LVT)) == 0) {
- SvREFCNT_dec(PL_utf8_X_LVT);
- PL_utf8_X_LVT = &PL_sv_undef;
- }
- }
-
- return (PL_utf8_X_LVT != &PL_sv_undef
- && cp >= SBASE && cp < SBASE + SCount
- && (cp - SBASE) % TCount != 0); /* All but every TCount one is LV */
-}
-
/*
* Local variables:
* c-indentation-style: bsd