#define STATIC static
#endif
+#ifndef MIN
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
struct RExC_state_t {
U32 flags; /* RXf_* are we folding, multilining? */
ANYOF_FLAGS(ssc) &= ~ANYOF_LOCALE_FLAGS;
}
+#define NON_OTHER_COUNT NON_OTHER_COUNT_FOR_USE_ONLY_BY_REGCOMP_DOT_C
+
+STATIC bool
+S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc)
+{
+ /* The synthetic start class is used to hopefully quickly winnow down
+ * places where a pattern could start a match in the target string. If it
+ * doesn't really narrow things down that much, there isn't much point to
+ * having the overhead of using it. This function uses some very crude
+ * heuristics to decide if to use the ssc or not.
+ *
+ * It returns TRUE if 'ssc' rules out more than half what it considers to
+ * be the "likely" possible matches, but of course it doesn't know what the
+ * actual things being matched are going to be; these are only guesses
+ *
+ * For /l matches, it assumes that the only likely matches are going to be
+ * in the 0-255 range, uniformly distributed, so half of that is 127
+ * For /a and /d matches, it assumes that the likely matches will be just
+ * the ASCII range, so half of that is 63
+ * For /u and there isn't anything matching above the Latin1 range, it
+ * assumes that that is the only range likely to be matched, and uses
+ * half that as the cut-off: 127. If anything matches above Latin1,
+ * it assumes that all of Unicode could match (uniformly), except for
+ * non-Unicode code points and things in the General Category "Other"
+ * (unassigned, private use, surrogates, controls and formats). This
+ * is a much large number. */
+
+ const U32 max_match = (LOC)
+ ? 127
+ : (! UNI_SEMANTICS)
+ ? 63
+ : (invlist_highest(ssc->invlist) < 256)
+ ? 127
+ : ((NON_OTHER_COUNT + 1) / 2) - 1;
+ U32 count = 0; /* Running total of number of code points matched by
+ 'ssc' */
+ UV start, end; /* Start and end points of current range in inversion
+ list */
+
+ PERL_ARGS_ASSERT_IS_SSC_WORTH_IT;
+
+ invlist_iterinit(ssc->invlist);
+ while (invlist_iternext(ssc->invlist, &start, &end)) {
+
+ /* /u is the only thing that we expect to match above 255; so if not /u
+ * and even if there are matches above 255, ignore them. This catches
+ * things like \d under /d which does match the digits above 255, but
+ * since the pattern is /d, it is not likely to be expecting them */
+ if (! UNI_SEMANTICS) {
+ if (start > 255) {
+ break;
+ }
+ end = MIN(end, 255);
+ }
+ count += end - start + 1;
+ if (count > max_match) {
+ invlist_iterfinish(ssc->invlist);
+ return FALSE;
+ }
+ }
+
+ return TRUE;
+}
+
+
STATIC void
S_ssc_finalize(pTHX_ RExC_state_t *pRExC_state, regnode_ssc *ssc)
{
if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
&& stclass_flag
&& ! (ANYOF_FLAGS(data.start_class) & SSC_MATCHES_EMPTY_STRING)
- && !ssc_is_anything(data.start_class))
+ && is_ssc_worth_it(pRExC_state, data.start_class))
{
const U32 n = add_data(pRExC_state, STR_WITH_LEN("f"));
= r->float_substr = r->float_utf8 = NULL;
if (! (ANYOF_FLAGS(data.start_class) & SSC_MATCHES_EMPTY_STRING)
- && ! ssc_is_anything(data.start_class))
+ && is_ssc_worth_it(pRExC_state, data.start_class))
{
const U32 n = add_data(pRExC_state, STR_WITH_LEN("f"));
/* assume we don't need to swap parens around before we match */
DEBUG_TEST_r({
PerlIO_printf(Perl_debug_log,"study_chunk_recursed_count: %lu\n",
- RExC_study_chunk_recursed_count);
+ (unsigned long)RExC_study_chunk_recursed_count);
});
DEBUG_DUMP_r({
DEBUG_RExC_seen();
regex_charset cs;
bool has_use_defaults = FALSE;
const char* const seqstart = RExC_parse - 1; /* Point to the '?' */
+ int x_mod_count = 0;
PERL_ARGS_ASSERT_PARSE_LPAREN_QUESTION_FLAGS;
switch (*RExC_parse) {
/* Code for the imsx flags */
- CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp);
+ CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp, x_mod_count);
case LOCALE_PAT_MOD:
if (has_charset_modifier) {
if (RExC_flags & RXf_PMf_FOLD) {
RExC_contains_i = 1;
}
+ if (PASS2) {
+ STD_PMMOD_FLAGS_PARSE_X_WARN(x_mod_count);
+ }
return;
/*NOTREACHED*/
default:
++RExC_parse;
}
+
+ if (PASS2) {
+ STD_PMMOD_FLAGS_PARSE_X_WARN(x_mod_count);
+ }
}
/*
num = RExC_npar + num - 1;
}
- ret = reganode(pRExC_state, GOSUB, num);
+ ret = reg2Lanode(pRExC_state, GOSUB, num, RExC_recurse_count);
if (!SIZE_ONLY) {
if (num > (I32)RExC_rx->nparens) {
RExC_parse++;
vFAIL("Reference to nonexistent group");
}
- ARG2L_SET( ret, RExC_recurse_count++);
- RExC_emit++;
+ RExC_recurse_count++;
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
"Recurse #%"UVuf" to %"IVdf"\n",
(UV)ARG(ret), (IV)ARG2L(ret)));
- } else {
- RExC_size++;
- }
- RExC_seen |= REG_RECURSE_SEEN;
+ }
+ RExC_seen |= REG_RECURSE_SEEN;
Set_Node_Length(ret, 1 + regarglen[OP(ret)]); /* MJD */
Set_Node_Offset(ret, parse_start); /* MJD */
if (is_logical) {
regnode *eval;
ret = reg_node(pRExC_state, LOGICAL);
- eval = reganode(pRExC_state, EVAL, n);
+
+ eval = reg2Lanode(pRExC_state, EVAL,
+ n,
+
+ /* for later propagation into (??{})
+ * return value */
+ RExC_flags & RXf_PMf_COMPILETIME
+ );
if (!SIZE_ONLY) {
ret->flags = 2;
- /* for later propagation into (??{}) return value */
- eval->flags = (U8) (RExC_flags & RXf_PMf_COMPILETIME);
}
REGTAIL(pRExC_state, ret, eval);
/* deal with the length of this later - MJD */
return ret;
}
- ret = reganode(pRExC_state, EVAL, n);
+ ret = reg2Lanode(pRExC_state, EVAL, n, 0);
Set_Node_Length(ret, RExC_parse - parse_start + 1);
Set_Node_Offset(ret, parse_start);
return ret;
case '(': /* (?(?{...})...) and (?(?=...)...) */
{
int is_define= 0;
+ const int DEFINE_len = sizeof("DEFINE") - 1;
if (RExC_parse[0] == '?') { /* (?(?...)) */
if (RExC_parse[1] == '=' || RExC_parse[1] == '!'
|| RExC_parse[1] == '<'
ret = reganode(pRExC_state,NGROUPP,num);
goto insert_if_check_paren;
}
- else if (RExC_parse[0] == 'D' &&
- RExC_parse[1] == 'E' &&
- RExC_parse[2] == 'F' &&
- RExC_parse[3] == 'I' &&
- RExC_parse[4] == 'N' &&
- RExC_parse[5] == 'E')
- {
+ else if (strnEQ(RExC_parse, "DEFINE",
+ MIN(DEFINE_len, RExC_end - RExC_parse)))
+ {
ret = reganode(pRExC_state,DEFINEP,0);
- RExC_parse +=6 ;
+ RExC_parse += DEFINE_len;
is_define = 1;
goto insert_if_check_paren;
}
}
else {
/* Is a backslash; get the code point of the char after it */
- if (UTF && ! UTF8_IS_INVARIANT(RExC_parse)) {
+ if (UTF && ! UTF8_IS_INVARIANT(UCHARAT(RExC_parse))) {
value = utf8n_to_uvchr((U8*)RExC_parse,
RExC_end - RExC_parse,
&numlen, UTF8_ALLOW_DEFAULT);
continue; /* Back to top of loop to get next char */
}
/* Here, is a single code point, and <value> contains it */
+#ifdef EBCDIC
+ /* We consider named characters to be literal characters */
+ literal_endpoint++;
+#endif
}
break;
case 'p':
* included. literal_endpoint==2 means both ends of the range used
* a literal character, not \x{foo} */
if (literal_endpoint == 2
- && ((prevvalue >= 'a' && value <= 'z')
- || (prevvalue >= 'A' && value <= 'Z')))
+ && ((isLOWER_A(prevvalue) && isLOWER_A(value))
+ || (isUPPER_A(prevvalue) && isUPPER_A(value))))
{
_invlist_intersection(this_range, PL_XPosix_ptrs[_CC_ASCII],
&this_range);
- /* Since this above only contains ascii, the intersection of it
- * with anything will still yield only ascii */
+ /* Since 'this_range' now only contains ascii, the intersection
+ * of it with anything will still yield only ascii */
_invlist_intersection(this_range, PL_XPosix_ptrs[_CC_ALPHA],
&this_range);
}
_invlist_union(cp_foldable_list, this_range, &cp_foldable_list);
literal_endpoint = 0;
+ SvREFCNT_dec_NN(this_range);
#endif
}
}
}
-/*
-- reg_node - emit a node
-*/
-STATIC regnode * /* Location. */
-S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
+STATIC regnode *
+S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const U8 op, const STRLEN extra_size, const char* const name)
{
- regnode *ptr;
+ /* Allocate a regnode for 'op' and returns it, with 'extra_size' extra
+ * space. In pass1, it aligns and increments RExC_size; in pass2,
+ * RExC_emit */
+
regnode * const ret = RExC_emit;
GET_RE_DEBUG_FLAGS_DECL;
- PERL_ARGS_ASSERT_REG_NODE;
+ PERL_ARGS_ASSERT_REGNODE_GUTS;
+
+ assert(extra_size >= regarglen[op]);
if (SIZE_ONLY) {
SIZE_ALIGN(RExC_size);
- RExC_size += 1;
+ RExC_size += 1 + extra_size;
return(ret);
}
if (RExC_emit >= RExC_emit_bound)
op, (void*)RExC_emit, (void*)RExC_emit_bound);
NODE_ALIGN_FILL(ret);
-#ifdef RE_TRACK_PATTERN_OFFSETS
+#ifndef RE_TRACK_PATTERN_OFFSETS
+ PERL_UNUSED_ARG(name);
+#else
if (RExC_offsets) { /* MJD */
MJD_OFFSET_DEBUG(
("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n",
- "reg_node", __LINE__,
+ name, __LINE__,
PL_reg_name[op],
(UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
Set_Node_Offset(RExC_emit, RExC_parse + (op == END));
}
#endif
- ptr = ret;
- FILL_ADVANCE_NODE(ptr, op);
- RExC_emit = ptr;
+ return(ret);
+}
+
+/*
+- reg_node - emit a node
+*/
+STATIC regnode * /* Location. */
+S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
+{
+ regnode * const ret = regnode_guts(pRExC_state, op, regarglen[op], "reg_node");
+
+ PERL_ARGS_ASSERT_REG_NODE;
+
+ assert(regarglen[op] == 0);
+
+ if (PASS2) {
+ regnode *ptr = ret;
+ FILL_ADVANCE_NODE(ptr, op);
+ RExC_emit = ptr;
+ }
return(ret);
}
STATIC regnode * /* Location. */
S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
{
- regnode *ptr;
- regnode * const ret = RExC_emit;
- GET_RE_DEBUG_FLAGS_DECL;
+ regnode * const ret = regnode_guts(pRExC_state, op, regarglen[op], "reganode");
PERL_ARGS_ASSERT_REGANODE;
- if (SIZE_ONLY) {
- SIZE_ALIGN(RExC_size);
- RExC_size += 2;
- /*
- We can't do this:
+ assert(regarglen[op] == 1);
- assert(2==regarglen[op]+1);
+ if (PASS2) {
+ regnode *ptr = ret;
+ FILL_ADVANCE_NODE_ARG(ptr, op, arg);
+ RExC_emit = ptr;
+ }
+ return(ret);
+}
- Anything larger than this has to allocate the extra amount.
- If we changed this to be:
+STATIC regnode *
+S_reg2Lanode(pTHX_ RExC_state_t *pRExC_state, const U8 op, const U32 arg1, const I32 arg2)
+{
+ /* emit a node with U32 and I32 arguments */
- RExC_size += (1 + regarglen[op]);
+ regnode * const ret = regnode_guts(pRExC_state, op, regarglen[op], "reg2Lanode");
- then it wouldn't matter. Its not clear what side effect
- might come from that so its not done so far.
- -- dmq
- */
- return(ret);
- }
- if (RExC_emit >= RExC_emit_bound)
- Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d, %p>=%p",
- op, (void*)RExC_emit, (void*)RExC_emit_bound);
+ PERL_ARGS_ASSERT_REG2LANODE;
- NODE_ALIGN_FILL(ret);
-#ifdef RE_TRACK_PATTERN_OFFSETS
- if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(
- ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
- "reganode",
- __LINE__,
- PL_reg_name[op],
- (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ?
- "Overwriting end of array!\n" : "OK",
- (UV)(RExC_emit - RExC_emit_start),
- (UV)(RExC_parse - RExC_start),
- (UV)RExC_offsets[0]));
- Set_Cur_Node_Offset;
+ assert(regarglen[op] == 2);
+
+ if (PASS2) {
+ regnode *ptr = ret;
+ FILL_ADVANCE_NODE_2L_ARG(ptr, op, arg1, arg2);
+ RExC_emit = ptr;
}
-#endif
- ptr = ret;
- FILL_ADVANCE_NODE_ARG(ptr, op, arg);
- RExC_emit = ptr;
return(ret);
}
#define MAX_PRINT_A MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C
-#ifndef MIN
-#define MIN(a,b) ((a) < (b) ? (a) : (b))
-#endif
-
STATIC void
S_put_range(pTHX_ SV *sv, UV start, const UV end, const bool allow_literals)
{
https://perl5.git.perl.org / perl5.git / blobdiff