#include "invlist_inline.h"
#include "unicode_constants.h"
-#define HAS_NONLATIN1_FOLD_CLOSURE(i) \
- _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
-#define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(i) \
- _HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
-#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
-#define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
-
#ifndef STATIC
#define STATIC static
#endif
U8 *study_chunk_recursed; /* bitmap of which subs we have moved
through */
U32 study_chunk_recursed_bytes; /* bytes in bitmap */
- I32 in_lookbehind;
- I32 in_lookahead;
+ I32 in_lookaround;
I32 contains_locale;
I32 override_recoding;
I32 recode_x_to_native;
#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed)
#define RExC_study_chunk_recursed_bytes \
(pRExC_state->study_chunk_recursed_bytes)
-#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
-#define RExC_in_lookahead (pRExC_state->in_lookahead)
+#define RExC_in_lookaround (pRExC_state->in_lookaround)
#define RExC_contains_locale (pRExC_state->contains_locale)
#define RExC_recode_x_to_native (pRExC_state->recode_x_to_native)
RExC_naughty += RExC_naughty / (exp) + (add)
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
-#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
- ((*s) == '{' && regcurly(s)))
+#define ISMULT2(s) (ISMULT1(*s) || ((*s) == '{' && regcurly(s)))
/*
* Flags to be passed up and down.
*/
#define HASWIDTH 0x01 /* Known to not match null strings, could match
non-null ones. */
-
-/* Simple enough to be STAR/PLUS operand; in an EXACTish node must be a single
- * character. (There needs to be a case: in the switch statement in regexec.c
- * for any node marked SIMPLE.) Note that this is not the same thing as
- * REGNODE_SIMPLE */
-#define SIMPLE 0x02
+#define SIMPLE 0x02 /* Exactly one character wide */
+ /* (or LNBREAK as a special case) */
#define POSTPONED 0x08 /* (?1),(?&name), (??{...}) or similar */
#define TRYAGAIN 0x10 /* Weeded out a declaration. */
#define RESTART_PARSE 0x20 /* Need to redo the parse */
} \
} STMT_END
+/* /u is to be chosen if we are supposed to use Unicode rules, or if the
+ * pattern is in UTF-8. This latter condition is in case the outermost rules
+ * are locale. See GH #17278 */
+#define toUSE_UNI_CHARSET_NOT_DEPENDS (RExC_uni_semantics || UTF)
+
/* Change from /d into /u rules, and restart the parse. RExC_uni_semantics is
* a flag that indicates we need to override /d with /u as a result of
* something in the pattern. It should only be used in regards to calling
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)
{
/* See if *uc is the beginning of a multi-character fold. If
* so, we decrement the length remaining to look at, to account
* for the current character this iteration. (We can use 'uc'
- * instead of the fold returned by TRIE_READ_CHAR because for
- * non-UTF, the latin1_safe macro is smart enough to account
- * for all the unfolded characters, and because for UTF, the
- * string will already have been folded earlier in the
- * compilation process */
+ * instead of the fold returned by TRIE_READ_CHAR because the
+ * macro is smart enough to account for any unfolded
+ * characters. */
if (UTF) {
if ((foldlen = is_MULTI_CHAR_FOLD_utf8_safe(uc, e))) {
foldlen -= UTF8SKIP(uc);
* might result in a minlen of 1 and not of 4,
* but this doesn't make us mismatch, just try a bit
* harder than we should.
- * */
+ *
+ * However we must assume this GOSUB is infinite, to
+ * avoid wrongly applying other optimizations in the
+ * enclosing scope - see GH 18096, for example.
+ */
+ is_inf = is_inf_internal = 1;
scan= regnext(scan);
continue;
}
continue;
}
}
- else if ( OP(scan) == EXACT
- || OP(scan) == LEXACT
- || OP(scan) == EXACT_REQ8
- || OP(scan) == LEXACT_REQ8
- || OP(scan) == EXACTL)
- {
+ else if (PL_regkind[OP(scan)] == EXACT && ! isEXACTFish(OP(scan))) {
SSize_t bytelen = STR_LEN(scan), charlen;
UV uc;
assert(bytelen);
case PLUS:
if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
next = NEXTOPER(scan);
- if ( OP(next) == EXACT
- || OP(next) == LEXACT
- || OP(next) == EXACT_REQ8
- || OP(next) == LEXACT_REQ8
- || OP(next) == EXACTL
+ if ( ( PL_regkind[OP(next)] == EXACT
+ && ! isEXACTFish(OP(next)))
|| (flags & SCF_DO_STCLASS))
{
mincount = 1;
}
if (flags & SCF_DO_SUBSTR)
data->pos_min++;
+ /* This will bypass the formal 'min += minnext * mincount'
+ * calculation in the do_curly path, so assumes min width
+ * of the PLUS payload is exactly one. */
min++;
/* FALLTHROUGH */
case STAR:
rx_flags = orig_rx_flags;
- if ( (UTF || RExC_uni_semantics)
+ if ( toUSE_UNI_CHARSET_NOT_DEPENDS
&& initial_charset == REGEX_DEPENDS_CHARSET)
{
RExC_seen = 0;
RExC_maxlen = 0;
- RExC_in_lookbehind = 0;
- RExC_in_lookahead = 0;
+ RExC_in_lookaround = 0;
RExC_seen_zerolen = *exp == '^' ? -1 : 0;
RExC_recode_x_to_native = 0;
RExC_in_multi_char_class = 0;
/* We have that number in RExC_npar */
RExC_total_parens = RExC_npar;
-
- /* XXX For backporting, use long jumps if there is any possibility of
- * overflow */
- if (RExC_size > U16_MAX && ! RExC_use_BRANCHJ) {
- RExC_use_BRANCHJ = TRUE;
- flags |= RESTART_PARSE;
- }
}
else if (! MUST_RESTART(flags)) {
ReREFCNT_dec(Rx);
DEBUG_PEEP("first:", first, 0, 0);
/* Ignore EXACT as we deal with it later. */
if (PL_regkind[OP(first)] == EXACT) {
- if ( OP(first) == EXACT
- || OP(first) == LEXACT
- || OP(first) == EXACT_REQ8
- || OP(first) == LEXACT_REQ8
- || OP(first) == EXACTL)
- {
+ if (! isEXACTFish(OP(first))) {
NOOP; /* Empty, get anchored substr later. */
}
else
&& nop == END)
RExC_rx->extflags |= RXf_WHITE;
else if ( RExC_rx->extflags & RXf_SPLIT
- && ( fop == EXACT || fop == LEXACT
- || fop == EXACT_REQ8 || fop == LEXACT_REQ8
- || fop == EXACTL)
+ && (PL_regkind[fop] == EXACT && ! isEXACTFish(fop))
&& STR_LEN(first) == 1
&& *(STRING(first)) == ' '
&& nop == END )
} else if (flags & RXapif_ONE) {
ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES));
av = MUTABLE_AV(SvRV(ret));
- length = av_tindex(av);
+ length = av_count(av);
SvREFCNT_dec_NN(ret);
- return newSViv(length + 1);
+ return newSViv(length);
} else {
Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar",
(int)flags);
/* Some characters match above-Latin1 ones under /i. This
* is true of EXACTFL ones when the locale is UTF-8 */
if (HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(uc)
- && (! isASCII(uc) || (OP(node) != EXACTFAA
- && OP(node) != EXACTFAA_NO_TRIE)))
+ && (! isASCII(uc) || ! inRANGE(OP(node), EXACTFAA,
+ EXACTFAA_NO_TRIE)))
{
add_above_Latin1_folds(pRExC_state, (U8) uc, &invlist);
}
* the folded string to be just past any possible multi-char
* fold.
*
- * Unlike the non-UTF-8 case, the macro for determining if a
- * string is a multi-char fold requires all the characters to
- * already be folded. This is because of all the complications
- * if not. Note that they are folded anyway, except in EXACTFL
- * nodes. Like the non-UTF case above, we punt if the node
- * begins with a multi-char fold */
+ * Like the non-UTF case above, we punt if the node begins with a
+ * multi-char fold */
if (is_MULTI_CHAR_FOLD_utf8_safe(s, e)) {
invlist = _add_range_to_invlist(invlist, 0, UV_MAX);
UV c = (k == 0) ? first_fold : remaining_folds[k-1];
/* /aa doesn't allow folds between ASCII and non- */
- if ( (OP(node) == EXACTFAA || OP(node) == EXACTFAA_NO_TRIE)
+ if ( inRANGE(OP(node), EXACTFAA, EXACTFAA_NO_TRIE)
&& isASCII(c) != isASCII(fc))
{
continue;
RExC_parse++;
has_use_defaults = TRUE;
STD_PMMOD_FLAGS_CLEAR(&RExC_flags);
- cs = (RExC_uni_semantics)
+ cs = (toUSE_UNI_CHARSET_NOT_DEPENDS)
? REGEX_UNICODE_CHARSET
: REGEX_DEPENDS_CHARSET;
set_regex_charset(&RExC_flags, cs);
else {
cs = get_regex_charset(RExC_flags);
if ( cs == REGEX_DEPENDS_CHARSET
- && RExC_uni_semantics)
+ && (toUSE_UNI_CHARSET_NOT_DEPENDS))
{
cs = REGEX_UNICODE_CHARSET;
}
* pattern (or target, not known until runtime) are
* utf8, or something in the pattern indicates unicode
* semantics */
- cs = (RExC_uni_semantics)
+ cs = (toUSE_UNI_CHARSET_NOT_DEPENDS)
? REGEX_UNICODE_CHARSET
: REGEX_DEPENDS_CHARSET;
has_charset_modifier = DEPENDS_PAT_MOD;
I32 after_freeze = 0;
I32 num; /* numeric backreferences */
SV * max_open; /* Max number of unclosed parens */
+ I32 was_in_lookaround = RExC_in_lookaround;
char * parse_start = RExC_parse; /* MJD */
char * const oregcomp_parse = RExC_parse;
*flagp = 0; /* Initialize. */
- if (RExC_in_lookbehind) {
- RExC_in_lookbehind++;
- }
- if (RExC_in_lookahead) {
- RExC_in_lookahead++;
- }
-
/* Having this true makes it feasible to have a lot fewer tests for the
* parse pointer being in scope. For example, we can write
* while(isFOO(*RExC_parse)) RExC_parse++;
lookbehind_alpha_assertions:
RExC_seen |= REG_LOOKBEHIND_SEEN;
- RExC_in_lookbehind++;
/*FALLTHROUGH*/
alpha_assertions:
+ RExC_in_lookaround++;
RExC_seen_zerolen++;
if (! start_arg) {
}
RExC_seen |= REG_LOOKBEHIND_SEEN;
- RExC_in_lookbehind++;
+ RExC_in_lookaround++;
RExC_parse++;
if (RExC_parse >= RExC_end) {
vFAIL("Sequence (?... not terminated");
break;
case '=': /* (?=...) */
RExC_seen_zerolen++;
- RExC_in_lookahead++;
+ RExC_in_lookaround++;
break;
case '!': /* (?!...) */
RExC_seen_zerolen++;
nextchar(pRExC_state);
return ret;
}
+ RExC_in_lookaround++;
break;
case '|': /* (?|...) */
/* branch reset, behave like a (?:...) except that
/* restore original flags, but keep (?p) and, if we've encountered
* something in the parse that changes /d rules into /u, keep the /u */
RExC_flags = oregflags | (RExC_flags & RXf_PMf_KEEPCOPY);
- if (DEPENDS_SEMANTICS && RExC_uni_semantics) {
+ if (DEPENDS_SEMANTICS && toUSE_UNI_CHARSET_NOT_DEPENDS) {
set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET);
}
if (RExC_parse >= RExC_end || UCHARAT(RExC_parse) != ')') {
NOT_REACHED; /* NOTREACHED */
}
- if (RExC_in_lookbehind) {
- RExC_in_lookbehind--;
- }
- if (RExC_in_lookahead) {
- RExC_in_lookahead--;
- }
if (after_freeze > RExC_npar)
RExC_npar = after_freeze;
+
+ RExC_in_lookaround = was_in_lookaround;
+
return(ret);
}
}
/*
+ - regcurly - a little FSA that accepts {\d+,?\d*}
+ Pulled from reg.c.
+ */
+bool
+Perl_regcurly(const char *s)
+{
+ PERL_ARGS_ASSERT_REGCURLY;
+
+ if (*s++ != '{')
+ return FALSE;
+ if (!isDIGIT(*s))
+ return FALSE;
+ while (isDIGIT(*s))
+ s++;
+ if (*s == ',') {
+ s++;
+ while (isDIGIT(*s))
+ s++;
+ }
+
+ return *s == '}';
+}
+
+/*
- regpiece - something followed by possible quantifier * + ? {n,m}
*
* Note that the branching code sequences used for ? and the general cases
FAIL2("panic: regatom returned failure, flags=%#" UVxf, (UV) flags);
}
- op = *RExC_parse;
-
- if (op == '{' && regcurly(RExC_parse)) {
- maxpos = NULL;
#ifdef RE_TRACK_PATTERN_OFFSETS
- parse_start = RExC_parse; /* MJD */
+ parse_start = RExC_parse;
#endif
- next = RExC_parse + 1;
- while (isDIGIT(*next) || *next == ',') {
- if (*next == ',') {
- if (maxpos)
- break;
- else
- maxpos = next;
- }
- next++;
- }
- if (*next == '}') { /* got one */
+
+ op = *RExC_parse;
+ switch (op) {
+
+ case '*':
+ nextchar(pRExC_state);
+ min = 0;
+ break;
+
+ case '+':
+ nextchar(pRExC_state);
+ min = 1;
+ break;
+
+ case '?':
+ nextchar(pRExC_state);
+ min = 0; max = 1;
+ break;
+
+ case '{': /* A '{' may or may not indicate a quantifier; call regcurly()
+ to determine which */
+ if (regcurly(RExC_parse)) {
const char* endptr;
- if (!maxpos)
- maxpos = next;
- RExC_parse++;
+
+ /* Here is a quantifier, parse for min and max values */
+ maxpos = NULL;
+ next = RExC_parse + 1;
+ while (isDIGIT(*next) || *next == ',') {
+ if (*next == ',') {
+ if (maxpos)
+ break;
+ else
+ maxpos = next;
+ }
+ next++;
+ }
+
+ assert(*next == '}');
+
+ if (!maxpos)
+ maxpos = next;
+ RExC_parse++;
if (isDIGIT(*RExC_parse)) {
endptr = RExC_end;
if (!grok_atoUV(RExC_parse, &uv, &endptr))
} else {
min = 0;
}
- if (*maxpos == ',')
- maxpos++;
- else
- maxpos = RExC_parse;
+ if (*maxpos == ',')
+ maxpos++;
+ else
+ maxpos = RExC_parse;
if (isDIGIT(*maxpos)) {
endptr = RExC_end;
if (!grok_atoUV(maxpos, &uv, &endptr))
vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
max = (I32)uv;
} else {
- max = REG_INFTY; /* meaning "infinity" */
+ max = REG_INFTY; /* meaning "infinity" */
}
- RExC_parse = next;
- nextchar(pRExC_state);
+
+ RExC_parse = next;
+ nextchar(pRExC_state);
if (max < min) { /* If can't match, warn and optimize to fail
unconditionally */
reginsert(pRExC_state, OPFAIL, orig_emit, depth+1);
*RExC_parse);
}
- do_curly:
- if ((flags&SIMPLE)) {
- if (min == 0 && max == REG_INFTY) {
-
- /* Going from 0..inf is currently forbidden in wildcard
- * subpatterns. The only reason is to make it harder to
- * write patterns that take a long long time to halt, and
- * because the use of this construct isn't necessary in
- * matching Unicode property values */
- if (RExC_pm_flags & PMf_WILDCARD) {
- RExC_parse++;
- /* diag_listed_as: Use of %s is not allowed in Unicode
- property wildcard subpatterns in regex; marked by
- <-- HERE in m/%s/ */
- vFAIL("Use of quantifier '*' is not allowed in"
- " Unicode property wildcard subpatterns");
- /* Note, don't need to worry about {0,}, as a '}' isn't
- * legal at all in wildcards, so wouldn't get this far
- * */
- }
- reginsert(pRExC_state, STAR, ret, depth+1);
- MARK_NAUGHTY(4);
- RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
- goto nest_check;
- }
- if (min == 1 && max == REG_INFTY) {
- reginsert(pRExC_state, PLUS, ret, depth+1);
- MARK_NAUGHTY(3);
- RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
- goto nest_check;
- }
- MARK_NAUGHTY_EXP(2, 2);
- reginsert(pRExC_state, CURLY, ret, depth+1);
- Set_Node_Offset(REGNODE_p(ret), parse_start+1); /* MJD */
- Set_Node_Cur_Length(REGNODE_p(ret), parse_start);
- }
- else {
- const regnode_offset w = reg_node(pRExC_state, WHILEM);
+ break;
+ } /* End of is regcurly() */
- FLAGS(REGNODE_p(w)) = 0;
- if (! REGTAIL(pRExC_state, ret, w)) {
- REQUIRE_BRANCHJ(flagp, 0);
- }
- if (RExC_use_BRANCHJ) {
- reginsert(pRExC_state, LONGJMP, ret, depth+1);
- reginsert(pRExC_state, NOTHING, ret, depth+1);
- NEXT_OFF(REGNODE_p(ret)) = 3; /* Go over LONGJMP. */
- }
- reginsert(pRExC_state, CURLYX, ret, depth+1);
- /* MJD hk */
- Set_Node_Offset(REGNODE_p(ret), parse_start+1);
- Set_Node_Length(REGNODE_p(ret),
- op == '{' ? (RExC_parse - parse_start) : 1);
+ /* Here was a '{', but what followed it didn't form a quantifier. */
+ /* FALLTHROUGH */
- if (RExC_use_BRANCHJ)
- NEXT_OFF(REGNODE_p(ret)) = 3; /* Go over NOTHING to
- LONGJMP. */
- if (! REGTAIL(pRExC_state, ret, reg_node(pRExC_state,
- NOTHING)))
- {
- REQUIRE_BRANCHJ(flagp, 0);
- }
- RExC_whilem_seen++;
- MARK_NAUGHTY_EXP(1, 4); /* compound interest */
- }
- FLAGS(REGNODE_p(ret)) = 0;
-
- if (min > 0)
- *flagp = 0;
- if (max > 0)
- *flagp |= HASWIDTH;
- ARG1_SET(REGNODE_p(ret), (U16)min);
- ARG2_SET(REGNODE_p(ret), (U16)max);
- if (max == REG_INFTY)
- RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
-
- goto nest_check;
- }
+ default:
+ *flagp = flags;
+ return(ret);
+ NOT_REACHED; /*NOTREACHED*/
}
- if (!ISMULT1(op)) {
- *flagp = flags;
- return(ret);
- }
+ /* Here we have a quantifier, and have calculated 'min' and 'max'.
+ *
+ * Check and possibly adjust a zero width operand */
+ if (! (flags & (HASWIDTH|POSTPONED))) {
+ if (max > REG_INFTY/3) {
+ if (origparse[0] == '\\' && origparse[1] == 'K') {
+ vFAIL2utf8f(
+ "%" UTF8f " is forbidden - matches null string"
+ " many times",
+ UTF8fARG(UTF, (RExC_parse >= origparse
+ ? RExC_parse - origparse
+ : 0),
+ origparse));
+ } else {
+ ckWARN2reg(RExC_parse,
+ "%" UTF8f " matches null string many times",
+ UTF8fARG(UTF, (RExC_parse >= origparse
+ ? RExC_parse - origparse
+ : 0),
+ origparse));
+ }
+ }
-#if 0 /* Now runtime fix should be reliable. */
+ /* There's no point in trying to match something 0 length more than
+ * once except for extra side effects, which we don't have here since
+ * not POSTPONED */
+ if (max > 1) {
+ max = 1;
+ if (min > max) {
+ min = max;
+ }
+ }
+ }
- /* if this is reinstated, don't forget to put this back into perldiag:
+ /* If this is a code block pass it up */
+ *flagp |= (flags & POSTPONED);
- =item Regexp *+ operand could be empty at {#} in regex m/%s/
+ if (max > 0) {
+ *flagp |= (flags & HASWIDTH);
+ if (max == REG_INFTY)
+ RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN;
+ }
- (F) The part of the regexp subject to either the * or + quantifier
- could match an empty string. The {#} shows in the regular
- expression about where the problem was discovered.
+ /* 'SIMPLE' operands don't require full generality */
+ if ((flags&SIMPLE)) {
+ if (max == REG_INFTY) {
+ if (min == 0) {
+ if (UNLIKELY(RExC_pm_flags & PMf_WILDCARD)) {
+ goto min0_maxINF_wildcard_forbidden;
+ }
- */
+ reginsert(pRExC_state, STAR, ret, depth+1);
+ MARK_NAUGHTY(4);
+ goto done_main_op;
+ }
+ else if (min == 1) {
+ reginsert(pRExC_state, PLUS, ret, depth+1);
+ MARK_NAUGHTY(3);
+ goto done_main_op;
+ }
+ }
- if (!(flags&HASWIDTH) && op != '?')
- vFAIL("Regexp *+ operand could be empty");
-#endif
+ /* Here, SIMPLE, but not the '*' and '+' special cases */
-#ifdef RE_TRACK_PATTERN_OFFSETS
- parse_start = RExC_parse;
-#endif
- nextchar(pRExC_state);
+ MARK_NAUGHTY_EXP(2, 2);
+ reginsert(pRExC_state, CURLY, ret, depth+1);
+ Set_Node_Offset(REGNODE_p(ret), parse_start+1); /* MJD */
+ Set_Node_Cur_Length(REGNODE_p(ret), parse_start);
+ }
+ else { /* not SIMPLE */
+ const regnode_offset w = reg_node(pRExC_state, WHILEM);
- *flagp = HASWIDTH;
-
- if (op == '*') {
- min = 0;
- goto do_curly;
- }
- else if (op == '+') {
- min = 1;
- goto do_curly;
- }
- else if (op == '?') {
- min = 0; max = 1;
- goto do_curly;
- }
- nest_check:
- if (!(flags&(HASWIDTH|POSTPONED)) && max > REG_INFTY/3) {
- if (origparse[0] == '\\' && origparse[1] == 'K') {
- vFAIL2utf8f(
- "%" UTF8f " is forbidden - matches null string many times",
- UTF8fARG(UTF, (RExC_parse >= origparse
- ? RExC_parse - origparse
- : 0),
- origparse));
- /* NOT-REACHED */
- } else {
- ckWARN2reg(RExC_parse,
- "%" UTF8f " matches null string many times",
- UTF8fARG(UTF, (RExC_parse >= origparse
- ? RExC_parse - origparse
- : 0),
- origparse));
+ FLAGS(REGNODE_p(w)) = 0;
+ if (! REGTAIL(pRExC_state, ret, w)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
+ if (RExC_use_BRANCHJ) {
+ reginsert(pRExC_state, LONGJMP, ret, depth+1);
+ reginsert(pRExC_state, NOTHING, ret, depth+1);
+ NEXT_OFF(REGNODE_p(ret)) = 3; /* Go over LONGJMP. */
+ }
+ reginsert(pRExC_state, CURLYX, ret, depth+1);
+ /* MJD hk */
+ Set_Node_Offset(REGNODE_p(ret), parse_start+1);
+ Set_Node_Length(REGNODE_p(ret),
+ op == '{' ? (RExC_parse - parse_start) : 1);
+
+ if (RExC_use_BRANCHJ)
+ NEXT_OFF(REGNODE_p(ret)) = 3; /* Go over NOTHING to
+ LONGJMP. */
+ if (! REGTAIL(pRExC_state, ret, reg_node(pRExC_state,
+ NOTHING)))
+ {
+ REQUIRE_BRANCHJ(flagp, 0);
}
+ RExC_whilem_seen++;
+ MARK_NAUGHTY_EXP(1, 4); /* compound interest */
}
+ /* Finish up the CURLY/CURLYX case */
+ FLAGS(REGNODE_p(ret)) = 0;
+
+ ARG1_SET(REGNODE_p(ret), (U16)min);
+ ARG2_SET(REGNODE_p(ret), (U16)max);
+
+ done_main_op:
+
+ /* Process any greediness modifiers */
if (*RExC_parse == '?') {
- nextchar(pRExC_state);
- reginsert(pRExC_state, MINMOD, ret, depth+1);
+ nextchar(pRExC_state);
+ reginsert(pRExC_state, MINMOD, ret, depth+1);
if (! REGTAIL(pRExC_state, ret, ret + NODE_STEP_REGNODE)) {
REQUIRE_BRANCHJ(flagp, 0);
}
}
}
+ /* Forbid extra quantifiers */
if (ISMULT2(RExC_parse)) {
- RExC_parse++;
- vFAIL("Nested quantifiers");
+ RExC_parse++;
+ vFAIL("Nested quantifiers");
}
return(ret);
+
+ min0_maxINF_wildcard_forbidden:
+
+ /* Here we are in a wildcard match, and the minimum match length is 0, and
+ * the max could be infinity. This is currently forbidden. The only
+ * reason is to make it harder to write patterns that take a long long time
+ * to halt, and because the use of this construct isn't necessary in
+ * matching Unicode property values */
+ RExC_parse++;
+ /* diag_listed_as: Use of %s is not allowed in Unicode property wildcard
+ subpatterns in regex; marked by <-- HERE in m/%s/
+ */
+ vFAIL("Use of quantifier '*' is not allowed in Unicode property wildcard"
+ " subpatterns");
+
+ /* Note, don't need to worry about the input being '{0,}', as a '}' isn't
+ * legal at all in wildcards, so can't get this far */
+
+ NOT_REACHED; /*NOTREACHED*/
}
STATIC bool
/* SBOL is shared with /^/ so we set the flags so we can tell
* /\A/ from /^/ in split. */
FLAGS(REGNODE_p(ret)) = 1;
- *flagp |= SIMPLE; /* Wrong, but too late to fix for 5.32 */
}
goto finish_meta_pat;
case 'G':
}
ret = reg_node(pRExC_state, GPOS);
RExC_seen |= REG_GPOS_SEEN;
- *flagp |= SIMPLE;
goto finish_meta_pat;
case 'K':
- if (!RExC_in_lookbehind && !RExC_in_lookahead) {
+ if (!RExC_in_lookaround) {
RExC_seen_zerolen++;
ret = reg_node(pRExC_state, KEEPS);
- *flagp |= SIMPLE;
/* XXX:dmq : disabling in-place substitution seems to
* be necessary here to avoid cases of memory corruption, as
* with: C<$_="x" x 80; s/x\K/y/> -- rgs
}
else {
ret = reg_node(pRExC_state, SEOL);
- *flagp |= SIMPLE; /* Wrong, but too late to fix for 5.32 */
}
RExC_seen_zerolen++; /* Do not optimize RE away */
goto finish_meta_pat;
}
else {
ret = reg_node(pRExC_state, EOS);
- *flagp |= SIMPLE; /* Wrong, but too late to fix for 5.32 */
}
RExC_seen_zerolen++; /* Do not optimize RE away */
goto finish_meta_pat;
ret = reg_node(pRExC_state, op);
FLAGS(REGNODE_p(ret)) = flags;
- *flagp |= SIMPLE;
-
goto finish_meta_pat;
}
* things */
maybe_exactfu = FALSE;
+ /* Although these two characters have folds that are
+ * locale-problematic, they also have folds to above Latin1
+ * that aren't a problem. Doing these now helps at
+ * runtime. */
+ if (UNLIKELY( ender == GREEK_CAPITAL_LETTER_MU
+ || ender == LATIN_CAPITAL_LETTER_SHARP_S))
+ {
+ goto fold_anyway;
+ }
+
/* Here, we are adding a problematic fold character.
* "Problematic" in this context means that its fold isn't
* known until runtime. (The non-problematic code points
*(s)++ = (U8) toFOLD(ender);
}
else {
- UV folded = _to_uni_fold_flags(
+ UV folded;
+
+ fold_anyway:
+ folded = _to_uni_fold_flags(
ender,
(U8 *) s, /* We have allocated extra space
in 's' so can't run off the
end */
&added_len,
- FOLD_FLAGS_FULL | ((ASCII_FOLD_RESTRICTED)
- ? FOLD_FLAGS_NOMIX_ASCII
- : 0));
+ FOLD_FLAGS_FULL
+ | (( ASCII_FOLD_RESTRICTED
+ || node_type == EXACTFL)
+ ? FOLD_FLAGS_NOMIX_ASCII
+ : 0));
if (UNLIKELY(len + added_len > max_string_len)) {
overflowed = TRUE;
break;
*
* The solution used here for peeking ahead is to look at that
* next character. If it isn't ASCII punctuation, then it will
- * be something that continues in an EXACTish node if there
- * were space. We append the fold of it to s, having reserved
- * enough room in s0 for the purpose. If we can't reasonably
- * peek ahead, we instead assume the worst case: that it is
- * something that would form the completion of a multi-char
- * fold.
+ * be something that would continue on in an EXACTish node if
+ * there were space. We append the fold of it to s, having
+ * reserved enough room in s0 for the purpose. If we can't
+ * reasonably peek ahead, we instead assume the worst case:
+ * that it is something that would form the completion of a
+ * multi-char fold.
*
* If we can't split between s and ender, we work backwards
* character-by-character down to s0. At each current point
FAIL2("panic: loc_correspondence[%d] is 0",
(int) (s - s_start));
}
+ Safefree(locfold_buf);
+ Safefree(loc_correspondence);
}
else {
upper_fill = s - s0;
if ( posix_warnings
&& RExC_warn_text
- && av_top_index(RExC_warn_text) > -1)
+ && av_count(RExC_warn_text) > 0)
{
*posix_warnings = RExC_warn_text;
}
*
* There is a line below that uses the same white space criteria but is outside
* this macro. Both here and there must use the same definition */
-#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p) \
+#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p, stop_p) \
STMT_START { \
if (do_skip) { \
- while (isBLANK_A(UCHARAT(p))) \
+ while (p < stop_p && isBLANK_A(UCHARAT(p))) \
{ \
p++; \
} \
initial_listsv_len = SvCUR(listsv);
SvTEMP_off(listsv); /* Grr, TEMPs and mortals are conflated. */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
assert(RExC_parse <= RExC_end);
invert = TRUE;
allow_mutiple_chars = FALSE;
MARK_NAUGHTY(1);
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
}
/* Check that they didn't say [:posix:] instead of [[:posix:]] */
output_posix_warnings(pRExC_state, posix_warnings);
}
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
+
if (RExC_parse >= stop_ptr) {
break;
}
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
-
if (UCHARAT(RExC_parse) == ']') {
break;
}
}
/* For each multi-character string ... */
- while (av_tindex(strings) >= 0) {
+ while (av_count(strings) > 0) {
/* ... Each entry is itself an array of code
* points. */
AV * this_string = (AV *) av_shift( strings);
- STRLEN cp_count = av_tindex(this_string) + 1;
+ STRLEN cp_count = av_count(this_string);
SV * final = newSV(cp_count * 4);
SvPVCLEAR(final);
/* Create another string of sequences of \x{...} */
- while (av_tindex(this_string) >= 0) {
+ while (av_count(this_string) > 0) {
SV * character = av_shift(this_string);
UV cp = SvUV(character);
}
} /* end of namedclass \blah */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
/* If 'range' is set, 'value' is the ending of a range--check its
* validity. (If value isn't a single code point in the case of a
char* next_char_ptr = RExC_parse + 1;
/* Get the next real char after the '-' */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr, RExC_end);
/* If the '-' is at the end of the class (just before the ']',
* it is a literal minus; otherwise it is a range */
}
#endif
if ( exact ) {
- switch (OP(REGNODE_p(scan))) {
- case LEXACT:
- case EXACT:
- case LEXACT_REQ8:
- case EXACT_REQ8:
- case EXACTL:
- case EXACTF:
- case EXACTFU_S_EDGE:
- case EXACTFAA_NO_TRIE:
- case EXACTFAA:
- case EXACTFU:
- case EXACTFU_REQ8:
- case EXACTFLU8:
- case EXACTFUP:
- case EXACTFL:
- if( exact == PSEUDO )
- exact= OP(REGNODE_p(scan));
- else if ( exact != OP(REGNODE_p(scan)) )
- exact= 0;
- case NOTHING:
- break;
- default:
+ if (PL_regkind[OP(REGNODE_p(scan))] == EXACT) {
+ if (exact == PSEUDO )
+ exact= OP(REGNODE_p(scan));
+ else if (exact != OP(REGNODE_p(scan)) )
exact= 0;
}
+ else if (OP(REGNODE_p(scan)) != NOTHING) {
+ exact= 0;
+ }
}
DEBUG_PARSE_r({
DEBUG_PARSE_MSG((scan==p ? "tsdy" : ""));
#define SAVEPVN(p, n) ((p) ? savepvn(p, n) : NULL)
/*
- re_dup_guts - duplicate a regexp.
+=for apidoc re_dup_guts
+Duplicate a regexp.
- This routine is expected to clone a given regexp structure. It is only
- compiled under USE_ITHREADS.
+This routine is expected to clone a given regexp structure. It is only
+compiled under USE_ITHREADS.
- After all of the core data stored in struct regexp is duplicated
- the regexp_engine.dupe method is used to copy any private data
- stored in the *pprivate pointer. This allows extensions to handle
- any duplication it needs to do.
+After all of the core data stored in struct regexp is duplicated
+the C<regexp_engine.dupe> method is used to copy any private data
+stored in the *pprivate pointer. This allows extensions to handle
+any duplication they need to do.
+
+=cut
See pregfree() and regfree_internal() if you change anything here.
*/
}
}
-#define MAX_PRINT_A MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C
-
STATIC void
S_put_range(pTHX_ SV *sv, UV start, const UV end, const bool allow_literals)
{
UV this_end;
const char * format;
- if (end - start < min_range_count) {
-
- /* Output chars individually when they occur in short ranges */
+ if ( end - start < min_range_count
+ && (end - start <= 2 || (isPRINT_A(start) && isPRINT_A(end))))
+ {
+ /* Output a range of 1 or 2 chars individually, or longer ranges
+ * when printable */
for (; start <= end; start++) {
put_code_point(sv, start);
}
goto append_name_to_msg;
}
- lookup_loose = get_cv("_charnames::_loose_regcomp_lookup", 0);
+ lookup_loose = get_cvs("_charnames::_loose_regcomp_lookup", 0);
if (! lookup_loose) {
Perl_croak(aTHX_
"panic: Can't find '_charnames::_loose_regcomp_lookup");
/* Try again stripping off any initial 'Is'. This is because we
* promise that an initial Is is optional. The same isn't true of
* names that start with 'In'. Those can match only blocks, and the
- * lookup table already has those accounted for. */
- if (starts_with_Is) {
+ * lookup table already has those accounted for. The lookup table also
+ * has already accounted for Perl extensions (without and = sign)
+ * starting with 'i's'. */
+ if (starts_with_Is && equals_pos >= 0) {
lookup_name += 2;
lookup_len -= 2;
equals_pos -= 2;
https://perl5.git.perl.org / perl5.git / blobdiff