regnode **recurse; /* Recurse regops */
I32 recurse_count; /* Number of recurse regops */
I32 in_lookbehind;
+ I32 contains_locale;
+ I32 override_recoding;
#if ADD_TO_REGEXEC
char *starttry; /* -Dr: where regtry was called. */
#define RExC_starttry (pRExC_state->starttry)
#define RExC_recurse (pRExC_state->recurse)
#define RExC_recurse_count (pRExC_state->recurse_count)
#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
+#define RExC_contains_locale (pRExC_state->contains_locale)
+#define RExC_override_recoding (pRExC_state->override_recoding)
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
/* Can match anything (initialization) */
STATIC void
-S_cl_anything(struct regnode_charclass_class *cl)
+S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
{
PERL_ARGS_ASSERT_CL_ANYTHING;
ANYOF_BITMAP_SETALL(cl);
- ANYOF_CLASS_ZERO(cl); /* all bits set, so class is irrelevant */
- cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL|ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL|ANYOF_LOCALE;
+ cl->flags = ANYOF_CLASS|ANYOF_EOS|ANYOF_UNICODE_ALL
+ |ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL;
+
+ /* If any portion of the regex is to operate under locale rules,
+ * initialization includes it. The reason this isn't done for all regexes
+ * is that the optimizer was written under the assumption that locale was
+ * all-or-nothing. Given the complexity and lack of documentation in the
+ * optimizer, and that there are inadequate test cases for locale, so many
+ * parts of it may not work properly, it is safest to avoid locale unless
+ * necessary. */
+ if (RExC_contains_locale) {
+ ANYOF_CLASS_SETALL(cl); /* /l uses class */
+ cl->flags |= ANYOF_LOCALE;
+ }
+ else {
+ ANYOF_CLASS_ZERO(cl); /* Only /l uses class now */
+ }
}
/* Can match anything (initialization) */
/* Can match anything (initialization) */
STATIC void
-S_cl_init(struct regnode_charclass_class *cl)
+S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
{
PERL_ARGS_ASSERT_CL_INIT;
Zero(cl, 1, struct regnode_charclass_class);
cl->type = ANYOF;
- cl_anything(cl);
+ cl_anything(pRExC_state, cl);
ARG_SET(cl, ANYOF_NONBITMAP_EMPTY);
}
/* These two functions currently do the exact same thing */
#define cl_init_zero S_cl_init
-/* 'And' a given class with another one. Can create false positives */
-/* cl should not be inverted */
+/* 'AND' a given class with another one. Can create false positives. 'cl'
+ * should not be inverted. 'and_with->flags & ANYOF_CLASS' should be 0 if
+ * 'and_with' is a regnode_charclass instead of a regnode_charclass_class. */
STATIC void
S_cl_and(struct regnode_charclass_class *cl,
const struct regnode_charclass_class *and_with)
}
}
else { /* and'd node is not inverted */
+ U8 outside_bitmap_but_not_utf8; /* Temp variable */
+
if (! ANYOF_NONBITMAP(and_with)) {
/* Here 'and_with' doesn't match anything outside the bitmap
/* Here, 'and_with' does match something outside the bitmap, and cl
* doesn't have a list of things to match outside the bitmap. If
* cl can match all code points above 255, the intersection will
- * be those above-255 code points that 'and_with' matches. There
- * may be false positives from code points in 'and_with' that are
- * outside the bitmap but below 256, but those get sorted out
- * after the synthetic start class succeeds). If cl can't match
- * all Unicode code points, it means here that it can't match *
- * anything outside the bitmap, so we leave the bitmap empty */
+ * be those above-255 code points that 'and_with' matches. If cl
+ * can't match all Unicode code points, it means that it can't
+ * match anything outside the bitmap (since the 'if' that got us
+ * into this block tested for that), so we leave the bitmap empty.
+ */
if (cl->flags & ANYOF_UNICODE_ALL) {
ARG_SET(cl, ARG(and_with));
+
+ /* and_with's ARG may match things that don't require UTF8.
+ * And now cl's will too, in spite of this being an 'and'. See
+ * the comments below about the kludge */
+ cl->flags |= and_with->flags & ANYOF_NONBITMAP_NON_UTF8;
}
}
else {
}
- /* Take the intersection of the two sets of flags */
+ /* Take the intersection of the two sets of flags. However, the
+ * ANYOF_NONBITMAP_NON_UTF8 flag is treated as an 'or'. This is a
+ * kludge around the fact that this flag is not treated like the others
+ * which are initialized in cl_anything(). The way the optimizer works
+ * is that the synthetic start class (SSC) is initialized to match
+ * anything, and then the first time a real node is encountered, its
+ * values are AND'd with the SSC's with the result being the values of
+ * the real node. However, there are paths through the optimizer where
+ * the AND never gets called, so those initialized bits are set
+ * inappropriately, which is not usually a big deal, as they just cause
+ * false positives in the SSC, which will just mean a probably
+ * imperceptible slow down in execution. However this bit has a
+ * higher false positive consequence in that it can cause utf8.pm,
+ * utf8_heavy.pl ... to be loaded when not necessary, which is a much
+ * bigger slowdown and also causes significant extra memory to be used.
+ * In order to prevent this, the code now takes a different tack. The
+ * bit isn't set unless some part of the regular expression needs it,
+ * but once set it won't get cleared. This means that these extra
+ * modules won't get loaded unless there was some path through the
+ * pattern that would have required them anyway, and so any false
+ * positives that occur by not ANDing them out when they could be
+ * aren't as severe as they would be if we treated this bit like all
+ * the others */
+ outside_bitmap_but_not_utf8 = (cl->flags | and_with->flags)
+ & ANYOF_NONBITMAP_NON_UTF8;
cl->flags &= and_with->flags;
+ cl->flags |= outside_bitmap_but_not_utf8;
}
}
-/* 'OR' a given class with another one. Can create false positives */
-/* cl should not be inverted */
+/* 'OR' a given class with another one. Can create false positives. 'cl'
+ * should not be inverted. 'or_with->flags & ANYOF_CLASS' should be 0 if
+ * 'or_with' is a regnode_charclass instead of a regnode_charclass_class. */
STATIC void
-S_cl_or(struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
+S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
{
PERL_ARGS_ASSERT_CL_OR;
* complement of everything not in the bitmap, but currently we don't
* know what that is, so give up and match anything */
if (ANYOF_NONBITMAP(or_with)) {
- cl_anything(cl);
+ cl_anything(pRExC_state, cl);
}
/* We do not use
* (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
cl->bitmap[i] |= ~or_with->bitmap[i];
} /* XXXX: logic is complicated otherwise */
else {
- cl_anything(cl);
+ cl_anything(pRExC_state, cl);
}
/* And, we can just take the union of the flags that aren't affected
}
}
else { /* XXXX: logic is complicated, leave it along for a moment. */
- cl_anything(cl);
+ cl_anything(pRExC_state, cl);
}
- /* Take the union */
- cl->flags |= or_with->flags;
-
if (ANYOF_NONBITMAP(or_with)) {
/* Use the added node's outside-the-bit-map match if there isn't a
* outside the bitmap, but what they match outside is not the same
* pointer, and hence not easily compared until XXX we extend
* inversion lists this far), give up and allow the start class to
- * match everything outside the bitmap */
+ * match everything outside the bitmap. If that stuff is all above
+ * 255, can just set UNICODE_ALL, otherwise caould be anything. */
if (! ANYOF_NONBITMAP(cl)) {
ARG_SET(cl, ARG(or_with));
}
else if (ARG(cl) != ARG(or_with)) {
- cl->flags |= ANYOF_UNICODE_ALL;
+
+ if ((or_with->flags & ANYOF_NONBITMAP_NON_UTF8)) {
+ cl_anything(pRExC_state, cl);
+ }
+ else {
+ cl->flags |= ANYOF_UNICODE_ALL;
+ }
}
}
+
+ /* Take the union */
+ cl->flags |= or_with->flags;
}
}
if (flags & SCF_DO_SUBSTR)
SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
if (flags & SCF_DO_STCLASS)
- cl_init_zero(&accum);
+ cl_init_zero(pRExC_state, &accum);
while (OP(scan) == code) {
I32 deltanext, minnext, f = 0, fake;
if (code != BRANCH)
scan = NEXTOPER(scan);
if (flags & SCF_DO_STCLASS) {
- cl_init(&this_class);
+ cl_init(pRExC_state, &this_class);
data_fake.start_class = &this_class;
f = SCF_DO_STCLASS_AND;
}
data->whilem_c = data_fake.whilem_c;
}
if (flags & SCF_DO_STCLASS)
- cl_or(&accum, &this_class);
+ cl_or(pRExC_state, &accum, &this_class);
}
if (code == IFTHEN && num < 2) /* Empty ELSE branch */
min1 = 0;
min += min1;
delta += max1 - min1;
if (flags & SCF_DO_STCLASS_OR) {
- cl_or(data->start_class, &accum);
+ cl_or(pRExC_state, data->start_class, &accum);
if (min1) {
cl_and(data->start_class, and_withp);
flags &= ~SCF_DO_STCLASS;
}
} else {
/*
- Currently we do not believe that the trie logic can
- handle case insensitive matching properly when the
- pattern is not unicode (thus forcing unicode semantics).
+ Currently the trie logic handles case insensitive matching properly only
+ when the pattern is UTF-8 and the node is EXACTFU (thus forcing unicode
+ semantics).
If/when this is fixed the following define can be swapped
in below to fully enable trie logic.
- XXX It may work if not UTF and/or /a (AT_LEAST_UNI_SEMANTICS) but perhaps
- not /aa
-
#define TRIE_TYPE_IS_SAFE 1
*/
-#define TRIE_TYPE_IS_SAFE ((UTF && UNI_SEMANTICS) || optype==EXACT)
+#define TRIE_TYPE_IS_SAFE ((UTF && optype == EXACTFU) || optype==EXACT)
if ( last && TRIE_TYPE_IS_SAFE ) {
make_trie( pRExC_state,
}
is_inf = is_inf_internal = 1;
if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
- cl_anything(data->start_class);
+ cl_anything(pRExC_state, data->start_class);
flags &= ~SCF_DO_STCLASS;
}
} else {
data->start_class->flags &= ~ANYOF_EOS;
data->start_class->flags |= ANYOF_LOC_NONBITMAP_FOLD;
if (OP(scan) == EXACTFL) {
+ /* XXX This set is probably no longer necessary, and
+ * probably wrong as LOCALE now is on in the initial
+ * state */
data->start_class->flags |= ANYOF_LOCALE;
}
else {
data->flags |= SF_IS_INF;
}
if (flags & SCF_DO_STCLASS) {
- cl_init(&this_class);
+ cl_init(pRExC_state, &this_class);
oclass = data->start_class;
data->start_class = &this_class;
f |= SCF_DO_STCLASS_AND;
data->start_class = oclass;
if (mincount == 0 || minnext == 0) {
if (flags & SCF_DO_STCLASS_OR) {
- cl_or(data->start_class, &this_class);
+ cl_or(pRExC_state, data->start_class, &this_class);
}
else if (flags & SCF_DO_STCLASS_AND) {
/* Switch to OR mode: cache the old value of
}
} else { /* Non-zero len */
if (flags & SCF_DO_STCLASS_OR) {
- cl_or(data->start_class, &this_class);
+ cl_or(pRExC_state, data->start_class, &this_class);
cl_and(data->start_class, and_withp);
}
else if (flags & SCF_DO_STCLASS_AND)
}
is_inf = is_inf_internal = 1;
if (flags & SCF_DO_STCLASS_OR)
- cl_anything(data->start_class);
+ cl_anything(pRExC_state, data->start_class);
flags &= ~SCF_DO_STCLASS;
break;
}
do_default:
/* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
- cl_anything(data->start_class);
+ cl_anything(pRExC_state, data->start_class);
break;
case REG_ANY:
if (OP(scan) == SANY)
if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
|| ANYOF_CLASS_TEST_ANY_SET(data->start_class));
- cl_anything(data->start_class);
+ cl_anything(pRExC_state, data->start_class);
}
if (flags & SCF_DO_STCLASS_AND || !value)
ANYOF_BITMAP_CLEAR(data->start_class,'\n');
cl_and(data->start_class,
(struct regnode_charclass_class*)scan);
else
- cl_or(data->start_class,
+ cl_or(pRExC_state, data->start_class,
(struct regnode_charclass_class*)scan);
break;
case ALNUM:
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
- else if (OP(scan) == ALNUMU) {
+
+ /* Even if under locale, set the bits for non-locale
+ * in case it isn't a true locale-node. This will
+ * create false positives if it truly is locale */
+ if (OP(scan) == ALNUMU) {
for (value = 0; value < 256; value++) {
if (isWORDCHAR_L1(value)) {
ANYOF_BITMAP_SET(data->start_class, value);
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
- else {
- if (OP(scan) == NALNUMU) {
- for (value = 0; value < 256; value++) {
- if (! isWORDCHAR_L1(value)) {
- ANYOF_BITMAP_SET(data->start_class, value);
- }
- }
- } else {
- for (value = 0; value < 256; value++) {
- if (! isALNUM(value)) {
- ANYOF_BITMAP_SET(data->start_class, value);
- }
- }
+
+ /* Even if under locale, set the bits for non-locale in
+ * case it isn't a true locale-node. This will create
+ * false positives if it truly is locale */
+ if (OP(scan) == NALNUMU) {
+ for (value = 0; value < 256; value++) {
+ if (! isWORDCHAR_L1(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
+ }
+ } else {
+ for (value = 0; value < 256; value++) {
+ if (! isALNUM(value)) {
+ ANYOF_BITMAP_SET(data->start_class, value);
+ }
}
}
}
if (data->start_class->flags & ANYOF_LOCALE) {
ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
}
- else if (OP(scan) == SPACEU) {
+ if (OP(scan) == SPACEU) {
for (value = 0; value < 256; value++) {
if (isSPACE_L1(value)) {
ANYOF_BITMAP_SET(data->start_class, value);
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
- else if (OP(scan) == NSPACEU) {
+ if (OP(scan) == NSPACEU) {
for (value = 0; value < 256; value++) {
if (!isSPACE_L1(value)) {
ANYOF_BITMAP_SET(data->start_class, value);
case DIGIT:
if (flags & SCF_DO_STCLASS_AND) {
if (!(data->start_class->flags & ANYOF_LOCALE)) {
- ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
- for (value = 0; value < 256; value++)
- if (!isDIGIT(value))
- ANYOF_BITMAP_CLEAR(data->start_class, value);
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
+ for (value = 0; value < 256; value++)
+ if (!isDIGIT(value))
+ ANYOF_BITMAP_CLEAR(data->start_class, value);
}
}
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
- else {
- for (value = 0; value < 256; value++)
- if (isDIGIT(value))
- ANYOF_BITMAP_SET(data->start_class, value);
- }
+ for (value = 0; value < 256; value++)
+ if (isDIGIT(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
}
break;
case NDIGIT:
if (flags & SCF_DO_STCLASS_AND) {
if (!(data->start_class->flags & ANYOF_LOCALE))
- ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
+ ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
for (value = 0; value < 256; value++)
if (isDIGIT(value))
ANYOF_BITMAP_CLEAR(data->start_class, value);
else {
if (data->start_class->flags & ANYOF_LOCALE)
ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
- else {
- for (value = 0; value < 256; value++)
- if (!isDIGIT(value))
- ANYOF_BITMAP_SET(data->start_class, value);
- }
+ for (value = 0; value < 256; value++)
+ if (!isDIGIT(value))
+ ANYOF_BITMAP_SET(data->start_class, value);
}
break;
CASE_SYNST_FNC(VERTWS);
data_fake.pos_delta = delta;
if ( flags & SCF_DO_STCLASS && !scan->flags
&& OP(scan) == IFMATCH ) { /* Lookahead */
- cl_init(&intrnl);
+ cl_init(pRExC_state, &intrnl);
data_fake.start_class = &intrnl;
f |= SCF_DO_STCLASS_AND;
}
* *** HACK *** for now just treat as "no information".
* See [perl #56690].
*/
- cl_init(data->start_class);
+ cl_init(pRExC_state, data->start_class);
} else {
/* AND before and after: combine and continue */
const int was = (data->start_class->flags & ANYOF_EOS);
data_fake.flags |= SF_IS_INF;
if ( flags & SCF_DO_STCLASS && !scan->flags
&& OP(scan) == IFMATCH ) { /* Lookahead */
- cl_init(&intrnl);
+ cl_init(pRExC_state, &intrnl);
data_fake.start_class = &intrnl;
f |= SCF_DO_STCLASS_AND;
}
}
is_inf = is_inf_internal = 1;
if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
- cl_anything(data->start_class);
+ cl_anything(pRExC_state, data->start_class);
flags &= ~SCF_DO_STCLASS;
}
else if (OP(scan) == GPOS) {
if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
if (flags & SCF_DO_STCLASS)
- cl_init_zero(&accum);
+ cl_init_zero(pRExC_state, &accum);
if (!trie->jump) {
min1= trie->minlen;
data_fake.last_closep = &fake;
data_fake.pos_delta = delta;
if (flags & SCF_DO_STCLASS) {
- cl_init(&this_class);
+ cl_init(pRExC_state, &this_class);
data_fake.start_class = &this_class;
f = SCF_DO_STCLASS_AND;
}
data->whilem_c = data_fake.whilem_c;
}
if (flags & SCF_DO_STCLASS)
- cl_or(&accum, &this_class);
+ cl_or(pRExC_state, &accum, &this_class);
}
}
if (flags & SCF_DO_SUBSTR) {
min += min1;
delta += max1 - min1;
if (flags & SCF_DO_STCLASS_OR) {
- cl_or(data->start_class, &accum);
+ cl_or(pRExC_state, data->start_class, &accum);
if (min1) {
cl_and(data->start_class, and_withp);
flags &= ~SCF_DO_STCLASS;
I32 sawplus = 0;
I32 sawopen = 0;
bool used_setjump = FALSE;
+ regex_charset initial_charset = get_regex_charset(orig_pm_flags);
U8 jump_ret = 0;
dJMPENV;
RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
RExC_uni_semantics = 0;
+ RExC_contains_locale = 0;
/****************** LONG JUMP TARGET HERE***********************/
/* Longjmp back to here if have to switch in midstream to utf8 */
restudied = 0;
#endif
- /* Set to use unicode semantics if the pattern is in utf8 and has the
- * 'depends' charset specified, as it means unicode when utf8 */
pm_flags = orig_pm_flags;
- if (RExC_utf8 && get_regex_charset(pm_flags) == REGEX_DEPENDS_CHARSET) {
+ if (initial_charset == REGEX_LOCALE_CHARSET) {
+ RExC_contains_locale = 1;
+ }
+ else if (RExC_utf8 && initial_charset == REGEX_DEPENDS_CHARSET) {
+
+ /* Set to use unicode semantics if the pattern is in utf8 and has the
+ * 'depends' charset specified, as it means unicode when utf8 */
set_regex_charset(&pm_flags, REGEX_UNICODE_CHARSET);
}
RExC_seen_zerolen = *exp == '^' ? -1 : 0;
RExC_seen_evals = 0;
RExC_extralen = 0;
+ RExC_override_recoding = 0;
/* First pass: determine size, legality. */
RExC_parse = exp;
data.longest = &(data.longest_fixed);
first = scan;
if (!ri->regstclass) {
- cl_init(&ch_class);
+ cl_init(pRExC_state, &ch_class);
data.start_class = &ch_class;
stclass_flag = SCF_DO_STCLASS_AND;
} else /* XXXX Check for BOUND? */
DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nMulti Top Level\n"));
scan = ri->program + 1;
- cl_init(&ch_class);
+ cl_init(pRExC_state, &ch_class);
data.start_class = &ch_class;
data.last_closep = &last_close;
* this file. An inversion list is here implemented as a malloc'd C array with
* some added info. More will be coming when functionality is added later.
*
+ * It is currently implemented as an HV to the outside world, but is actually
+ * an SV pointing to an array of UVs that the SV thinks are bytes. This allows
+ * us to have an array of UV whose memory management is automatically handled
+ * by the existing facilities for SV's.
+ *
* Some of the methods should always be private to the implementation, and some
* should eventually be made public */
#define INVLIST_INITIAL_LEN 10
-#define INVLIST_ARRAY_KEY "array"
-#define INVLIST_MAX_KEY "max"
-#define INVLIST_LEN_KEY "len"
PERL_STATIC_INLINE UV*
S_invlist_array(pTHX_ HV* const invlist)
* length changes, this needs to be called in case malloc or realloc moved
* it */
- SV** list_ptr = hv_fetchs(invlist, INVLIST_ARRAY_KEY, FALSE);
-
PERL_ARGS_ASSERT_INVLIST_ARRAY;
- if (list_ptr == NULL) {
- Perl_croak(aTHX_ "panic: inversion list without a '%s' element",
- INVLIST_ARRAY_KEY);
- }
-
- return INT2PTR(UV *, SvUV(*list_ptr));
-}
-
-PERL_STATIC_INLINE void
-S_invlist_set_array(pTHX_ HV* const invlist, const UV* const array)
-{
- PERL_ARGS_ASSERT_INVLIST_SET_ARRAY;
-
- /* Sets the array stored in the inversion list to the memory beginning with
- * the parameter */
-
- if (hv_stores(invlist, INVLIST_ARRAY_KEY, newSVuv(PTR2UV(array))) == NULL) {
- Perl_croak(aTHX_ "panic: can't store '%s' entry in inversion list",
- INVLIST_ARRAY_KEY);
- }
+ return (UV *) SvPVX(invlist);
}
PERL_STATIC_INLINE UV
{
/* Returns the current number of elements in the inversion list's array */
- SV** len_ptr = hv_fetchs(invlist, INVLIST_LEN_KEY, FALSE);
-
PERL_ARGS_ASSERT_INVLIST_LEN;
- if (len_ptr == NULL) {
- Perl_croak(aTHX_ "panic: inversion list without a '%s' element",
- INVLIST_LEN_KEY);
- }
-
- return SvUV(*len_ptr);
+ return SvCUR(invlist) / sizeof(UV);
}
PERL_STATIC_INLINE UV
/* Returns the maximum number of elements storable in the inversion list's
* array, without having to realloc() */
- SV** max_ptr = hv_fetchs(invlist, INVLIST_MAX_KEY, FALSE);
-
PERL_ARGS_ASSERT_INVLIST_MAX;
- if (max_ptr == NULL) {
- Perl_croak(aTHX_ "panic: inversion list without a '%s' element",
- INVLIST_MAX_KEY);
- }
-
- return SvUV(*max_ptr);
+ return SvLEN(invlist) / sizeof(UV);
}
PERL_STATIC_INLINE void
PERL_ARGS_ASSERT_INVLIST_SET_LEN;
- if (len != 0 && len > invlist_max(invlist)) {
- Perl_croak(aTHX_ "panic: Can't make '%s=%"UVuf"' more than %s=%"UVuf" in inversion list", INVLIST_LEN_KEY, len, INVLIST_MAX_KEY, invlist_max(invlist));
- }
-
- if (hv_stores(invlist, INVLIST_LEN_KEY, newSVuv(len)) == NULL) {
- Perl_croak(aTHX_ "panic: can't store '%s' entry in inversion list",
- INVLIST_LEN_KEY);
- }
+ SvCUR_set(invlist, len * sizeof(UV));
}
PERL_STATIC_INLINE void
PERL_ARGS_ASSERT_INVLIST_SET_MAX;
if (max < invlist_len(invlist)) {
- Perl_croak(aTHX_ "panic: Can't make '%s=%"UVuf"' less than %s=%"UVuf" in inversion list", INVLIST_MAX_KEY, invlist_len(invlist), INVLIST_LEN_KEY, invlist_max(invlist));
+ Perl_croak(aTHX_ "panic: Can't make max size '%"UVuf"' less than current length %"UVuf" in inversion list", invlist_max(invlist), invlist_len(invlist));
}
- if (hv_stores(invlist, INVLIST_MAX_KEY, newSVuv(max)) == NULL) {
- Perl_croak(aTHX_ "panic: can't store '%s' entry in inversion list",
- INVLIST_LEN_KEY);
- }
+ SvLEN_set(invlist, max * sizeof(UV));
}
#ifndef PERL_IN_XSUB_RE
* space to store 'initial_size' elements. If that number is negative, a
* system default is used instead */
- HV* invlist = newHV();
- UV* list;
-
if (initial_size < 0) {
initial_size = INVLIST_INITIAL_LEN;
}
/* Allocate the initial space */
- Newx(list, initial_size, UV);
- invlist_set_array(invlist, list);
-
- /* set_len has to come before set_max, as the latter inspects the len */
- invlist_set_len(invlist, 0);
- invlist_set_max(invlist, initial_size);
-
- return invlist;
+ return (HV *) newSV(initial_size * sizeof(UV));
}
#endif
{
/* Inversion list destructor */
- SV** list_ptr = hv_fetchs(invlist, INVLIST_ARRAY_KEY, FALSE);
-
PERL_ARGS_ASSERT_INVLIST_DESTROY;
- if (list_ptr != NULL) {
- UV *list = INT2PTR(UV *, SvUV(*list_ptr)); /* PERL_POISON needs lvalue */
- Safefree(list);
- }
+ SvREFCNT_dec(invlist);
}
STATIC void
S_invlist_extend(pTHX_ HV* const invlist, const UV new_max)
{
- /* Change the maximum size of an inversion list (up or down) */
-
- UV* orig_array;
- UV* array;
- const UV old_max = invlist_max(invlist);
+ /* Grow the maximum size of an inversion list */
PERL_ARGS_ASSERT_INVLIST_EXTEND;
- if (old_max == new_max) { /* If a no-op */
- return;
- }
-
- array = orig_array = invlist_array(invlist);
- Renew(array, new_max, UV);
-
- /* If the size change moved the list in memory, set the new one */
- if (array != orig_array) {
- invlist_set_array(invlist, array);
- }
-
- invlist_set_max(invlist, new_max);
-
+ SvGROW((SV *)invlist, new_max * sizeof(UV));
}
PERL_STATIC_INLINE void
/* Change the length of the inversion list to how many entries it currently
* has */
- invlist_extend(invlist, invlist_len(invlist));
+ SvPV_shrink_to_cur((SV *) invlist);
}
/* An element is in an inversion list iff its index is even numbered: 0, 2, 4,
* etc */
#define ELEMENT_IN_INVLIST_SET(i) (! ((i) & 1))
+#define PREV_ELEMENT_IN_INVLIST_SET(i) ! ELEMENT_IN_INVLIST_SET(i)
#ifndef PERL_IN_XSUB_RE
void
/* Here, we are finished going through at least one of the lists, which
* means there is something remaining in at most one. We check if the list
* that hasn't been exhausted is positioned such that we are in the middle
- * of a range in its set or not. (We are in the set if the next item in
- * the array marks the beginning of something not in the set) If in the
- * set, we decrement 'count'; if 0, there is potentially more to output.
+ * of a range in its set or not. (i_a and i_b point to the element beyond
+ * the one we care about.) If in the set, we decrement 'count'; if 0, there
+ * is potentially more to output.
* There are four cases:
* 1) Both weren't in their sets, count is 0, and remains 0. What's left
* in the union is entirely from the non-exhausted set.
* that
* 3) the exhausted was in its set, non-exhausted isn't, count is 1.
* Nothing further should be output because the union includes
- * everything from the exhausted set. Not decrementing insures that.
+ * everything from the exhausted set. Not decrementing ensures that.
* 4) the exhausted wasn't in its set, non-exhausted is, count is 1;
* decrementing to 0 insures that we look at the remainder of the
* non-exhausted set */
- if ((i_a != len_a && ! ELEMENT_IN_INVLIST_SET(i_a))
- || (i_b != len_b && ! ELEMENT_IN_INVLIST_SET(i_b)))
+ if ((i_a != len_a && PREV_ELEMENT_IN_INVLIST_SET(i_a))
+ || (i_b != len_b && PREV_ELEMENT_IN_INVLIST_SET(i_b)))
{
count--;
}
/* Return the intersection of two inversion lists. The basis for this
* comes from "Unicode Demystified" Chapter 13 by Richard Gillam, published
* by Addison-Wesley, and explained at some length there. The preface says
- * to incorporate its examples into your code at your own risk.
+ * to incorporate its examples into your code at your own risk. In fact,
+ * it had bugs
*
* The algorithm is like a merge sort, and is essentially the same as the
* union above
array */
bool cp_in_set; /* Is it in the input list's set or not */
- /* We need to take one or the other of the two inputs for the union.
- * Since we are merging two sorted lists, we take the smaller of the
- * next items. In case of a tie, we take the one that is not in its
- * set first (a difference from the union algorithm). If we took one
- * in the set first, it would increment the count, possibly to 2 which
- * would cause it to be output as starting a range in the intersection,
- * and the next time through we would take that same number, and output
- * it again as ending the set. By doing it the opposite of this, we
- * there is no possibility that the count will be momentarily
- * incremented to 2. (In a tie and both are in the set or both not in
- * the set, it doesn't matter which we take first.) */
+ /* We need to take one or the other of the two inputs for the
+ * intersection. Since we are merging two sorted lists, we take the
+ * smaller of the next items. In case of a tie, we take the one that
+ * is not in its set first (a difference from the union algorithm). If
+ * we took one in the set first, it would increment the count, possibly
+ * to 2 which would cause it to be output as starting a range in the
+ * intersection, and the next time through we would take that same
+ * number, and output it again as ending the set. By doing it the
+ * opposite of this, there is no possibility that the count will be
+ * momentarily incremented to 2. (In a tie and both are in the set or
+ * both not in the set, it doesn't matter which we take first.) */
if (array_a[i_a] < array_b[i_b]
|| (array_a[i_a] == array_b[i_b] && ! ELEMENT_IN_INVLIST_SET(i_a)))
{
}
}
- /* Here, we are finished going through at least one of the sets, which
- * means there is something remaining in at most one. See the comments in
- * the union code */
- if ((i_a != len_a && ! ELEMENT_IN_INVLIST_SET(i_a))
- || (i_b != len_b && ! ELEMENT_IN_INVLIST_SET(i_b)))
+ /* Here, we are finished going through at least one of the lists, which
+ * means there is something remaining in at most one. We check if the list
+ * that has been exhausted is positioned such that we are in the middle
+ * of a range in its set or not. (i_a and i_b point to elements 1 beyond
+ * the ones we care about.) There are four cases:
+ * 1) Both weren't in their sets, count is 0, and remains 0. There's
+ * nothing left in the intersection.
+ * 2) Both were in their sets, count is 2 and perhaps is incremented to
+ * above 2. What should be output is exactly that which is in the
+ * non-exhausted set, as everything it has is also in the intersection
+ * set, and everything it doesn't have can't be in the intersection
+ * 3) The exhausted was in its set, non-exhausted isn't, count is 1, and
+ * gets incremented to 2. Like the previous case, the intersection is
+ * everything that remains in the non-exhausted set.
+ * 4) the exhausted wasn't in its set, non-exhausted is, count is 1, and
+ * remains 1. And the intersection has nothing more. */
+ if ((i_a == len_a && PREV_ELEMENT_IN_INVLIST_SET(i_a))
+ || (i_b == len_b && PREV_ELEMENT_IN_INVLIST_SET(i_b)))
{
- count--;
+ count++;
}
/* The final length is what we've output so far plus what else is in the
- * intersection. Only one of the subexpressions below will be non-zero */
+ * intersection. At most one of the subexpressions below will be non-zero */
len_r = i_r;
- if (count == 2) {
+ if (count >= 2) {
len_r += (len_a - i_a) + (len_b - i_b);
}
}
/* Finish outputting any remaining */
- if (count == 2) { /* Only one of will have a non-zero copy count */
+ if (count >= 2) { /* At most one will have a non-zero copy count */
IV copy_count;
if ((copy_count = len_a - i_a) > 0) {
Copy(array_a + i_a, array_r + i_r, copy_count, UV);
{
U32 posflags = 0, negflags = 0;
U32 *flagsp = &posflags;
- bool has_charset_modifier = 0;
+ char has_charset_modifier = '\0';
regex_charset cs = (RExC_utf8 || RExC_uni_semantics)
? REGEX_UNICODE_CHARSET
: REGEX_DEPENDS_CHARSET;
switch (*RExC_parse) {
CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp);
case LOCALE_PAT_MOD:
- if (has_charset_modifier || flagsp == &negflags) {
- goto fail_modifiers;
+ if (has_charset_modifier) {
+ goto excess_modifier;
+ }
+ else if (flagsp == &negflags) {
+ goto neg_modifier;
}
cs = REGEX_LOCALE_CHARSET;
- has_charset_modifier = 1;
+ has_charset_modifier = LOCALE_PAT_MOD;
+ RExC_contains_locale = 1;
break;
case UNICODE_PAT_MOD:
- if (has_charset_modifier || flagsp == &negflags) {
- goto fail_modifiers;
+ if (has_charset_modifier) {
+ goto excess_modifier;
+ }
+ else if (flagsp == &negflags) {
+ goto neg_modifier;
}
cs = REGEX_UNICODE_CHARSET;
- has_charset_modifier = 1;
+ has_charset_modifier = UNICODE_PAT_MOD;
break;
case ASCII_RESTRICT_PAT_MOD:
- if (has_charset_modifier || flagsp == &negflags) {
- goto fail_modifiers;
+ if (flagsp == &negflags) {
+ goto neg_modifier;
}
- if (*(RExC_parse + 1) == ASCII_RESTRICT_PAT_MOD) {
+ if (has_charset_modifier) {
+ if (cs != REGEX_ASCII_RESTRICTED_CHARSET) {
+ goto excess_modifier;
+ }
/* Doubled modifier implies more restricted */
- cs = REGEX_ASCII_MORE_RESTRICTED_CHARSET;
- RExC_parse++;
- }
+ cs = REGEX_ASCII_MORE_RESTRICTED_CHARSET;
+ }
else {
cs = REGEX_ASCII_RESTRICTED_CHARSET;
}
- has_charset_modifier = 1;
+ has_charset_modifier = ASCII_RESTRICT_PAT_MOD;
break;
case DEPENDS_PAT_MOD:
- if (has_use_defaults
- || has_charset_modifier
- || flagsp == &negflags)
- {
+ if (has_use_defaults) {
goto fail_modifiers;
+ }
+ else if (flagsp == &negflags) {
+ goto neg_modifier;
+ }
+ else if (has_charset_modifier) {
+ goto excess_modifier;
}
/* The dual charset means unicode semantics if the
cs = (RExC_utf8 || RExC_uni_semantics)
? REGEX_UNICODE_CHARSET
: REGEX_DEPENDS_CHARSET;
- has_charset_modifier = 1;
+ has_charset_modifier = DEPENDS_PAT_MOD;
break;
+ excess_modifier:
+ RExC_parse++;
+ if (has_charset_modifier == ASCII_RESTRICT_PAT_MOD) {
+ vFAIL2("Regexp modifier \"%c\" may appear a maximum of twice", ASCII_RESTRICT_PAT_MOD);
+ }
+ else if (has_charset_modifier == *(RExC_parse - 1)) {
+ vFAIL2("Regexp modifier \"%c\" may not appear twice", *(RExC_parse - 1));
+ }
+ else {
+ vFAIL3("Regexp modifiers \"%c\" and \"%c\" are mutually exclusive", has_charset_modifier, *(RExC_parse - 1));
+ }
+ /*NOTREACHED*/
+ neg_modifier:
+ RExC_parse++;
+ vFAIL2("Regexp modifier \"%c\" may not appear after the \"-\"", *(RExC_parse - 1));
+ /*NOTREACHED*/
case ONCE_PAT_MOD: /* 'o' */
case GLOBAL_PAT_MOD: /* 'g' */
if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
const char * const origparse = RExC_parse;
I32 min;
I32 max = REG_INFTY;
+#ifdef RE_TRACK_PATTERN_OFFSETS
char *parse_start;
+#endif
const char *maxpos = NULL;
GET_RE_DEBUG_FLAGS_DECL;
if (op == '{' && regcurly(RExC_parse)) {
maxpos = NULL;
+#ifdef RE_TRACK_PATTERN_OFFSETS
parse_start = RExC_parse; /* MJD */
+#endif
next = RExC_parse + 1;
while (isDIGIT(*next) || *next == ',') {
if (*next == ',') {
vFAIL("Regexp *+ operand could be empty");
#endif
+#ifdef RE_TRACK_PATTERN_OFFSETS
parse_start = RExC_parse;
+#endif
nextchar(pRExC_state);
*flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
}
-/* reg_namedseq(pRExC_state,UVp)
+/* reg_namedseq(pRExC_state,UVp, UV depth)
This is expected to be called by a parser routine that has
recognized '\N' and needs to handle the rest. RExC_parse is
Parsing failures will generate a fatal error via vFAIL(...)
*/
STATIC regnode *
-S_reg_namedseq(pTHX_ RExC_state_t *pRExC_state, UV *valuep, I32 *flagp)
+S_reg_namedseq(pTHX_ RExC_state_t *pRExC_state, UV *valuep, I32 *flagp, U32 depth)
{
char * endbrace; /* '}' following the name */
regnode *ret = NULL;
-#ifdef DEBUGGING
- char* parse_start = RExC_parse - 2; /* points to the '\N' */
-#endif
char* p;
GET_RE_DEBUG_FLAGS_DECL;
ret = (regnode *) &RExC_parse; /* Invalid regnode pointer */
}
else { /* Not a char class */
- char *s; /* String to put in generated EXACT node */
- STRLEN len = 0; /* Its current byte length */
+
+ /* What is done here is to convert this to a sub-pattern of the form
+ * (?:\x{char1}\x{char2}...)
+ * and then call reg recursively. That way, it retains its atomicness,
+ * while not having to worry about special handling that some code
+ * points may have. toke.c has converted the original Unicode values
+ * to native, so that we can just pass on the hex values unchanged. We
+ * do have to set a flag to keep recoding from happening in the
+ * recursion */
+
+ SV * substitute_parse = newSVpvn_flags("?:", 2, SVf_UTF8|SVs_TEMP);
+ STRLEN len;
char *endchar; /* Points to '.' or '}' ending cur char in the input
stream */
- ret = reg_node(pRExC_state,
- (U8) ((! FOLD) ? EXACT
- : (LOC)
- ? EXACTFL
- : (MORE_ASCII_RESTRICTED)
- ? EXACTFA
- : (AT_LEAST_UNI_SEMANTICS)
- ? EXACTFU
- : EXACTF));
- s= STRING(ret);
-
- /* Exact nodes can hold only a U8 length's of text = 255. Loop through
- * the input which is of the form now 'c1.c2.c3...}' until find the
- * ending brace or exceed length 255. The characters that exceed this
- * limit are dropped. The limit could be relaxed should it become
- * desirable by reparsing this as (?:\N{NAME}), so could generate
- * multiple EXACT nodes, as is done for just regular input. But this
- * is primarily a named character, and not intended to be a huge long
- * string, so 255 bytes should be good enough */
- while (1) {
- STRLEN length_of_hex;
- I32 grok_flags = PERL_SCAN_ALLOW_UNDERSCORES
- | PERL_SCAN_DISALLOW_PREFIX
- | (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
- UV cp; /* Ord of current character */
- bool use_this_char_fold = FOLD;
+ char *orig_end = RExC_end;
+
+ while (RExC_parse < endbrace) {
/* Code points are separated by dots. If none, there is only one
* code point, and is terminated by the brace */
endchar = RExC_parse + strcspn(RExC_parse, ".}");
- /* The values are Unicode even on EBCDIC machines */
- length_of_hex = (STRLEN)(endchar - RExC_parse);
- cp = grok_hex(RExC_parse, &length_of_hex, &grok_flags, NULL);
- if ( length_of_hex == 0
- || length_of_hex != (STRLEN)(endchar - RExC_parse) )
- {
- RExC_parse += length_of_hex; /* Includes all the valid */
- RExC_parse += (RExC_orig_utf8) /* point to after 1st invalid */
- ? UTF8SKIP(RExC_parse)
- : 1;
- /* Guard against malformed utf8 */
- if (RExC_parse >= endchar) RExC_parse = endchar;
- vFAIL("Invalid hexadecimal number in \\N{U+...}");
- }
-
- /* XXX ? Change to ANYOF node
- if (FOLD
- && (cp > 255 || (! MORE_ASCII_RESTRICTED && ! LOC))
- && is_TRICKYFOLD_cp(cp))
- {
- }
- */
-
- /* Under /aa, we can't mix ASCII with non- in a fold. If we are
- * folding, and the source isn't ASCII, look through all the
- * characters it folds to. If any one of them is ASCII, forbid
- * this fold. (cp is uni, so the 127 below is correct even for
- * EBCDIC). Similarly under locale rules, we don't mix under 256
- * with above 255. XXX It really doesn't make sense to have \N{}
- * which means a Unicode rules under locale. I (khw) think this
- * should be warned about, but the counter argument is that people
- * who have programmed around Perl's earlier lack of specifying the
- * rules and used \N{} to force Unicode things in a local
- * environment shouldn't get suddenly a warning */
- if (use_this_char_fold) {
- if (LOC && cp < 256) { /* Fold not known until run-time */
- use_this_char_fold = FALSE;
- }
- else if ((cp > 127 && MORE_ASCII_RESTRICTED)
- || (cp > 255 && LOC))
- {
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
- U8* s = tmpbuf;
- U8* e;
- STRLEN foldlen;
-
- (void) toFOLD_uni(cp, tmpbuf, &foldlen);
- e = s + foldlen;
-
- while (s < e) {
- if (isASCII(*s)
- || (LOC && (UTF8_IS_INVARIANT(*s)
- || UTF8_IS_DOWNGRADEABLE_START(*s))))
- {
- use_this_char_fold = FALSE;
- break;
- }
- s += UTF8SKIP(s);
- }
- }
- }
-
- if (! use_this_char_fold) { /* Not folding, just append to the
- string */
- STRLEN unilen;
-
- /* Quit before adding this character if would exceed limit */
- if (len + UNISKIP(cp) > U8_MAX) break;
-
- unilen = reguni(pRExC_state, cp, s);
- if (unilen > 0) {
- s += unilen;
- len += unilen;
- }
- } else { /* Folding, output the folded equivalent */
- STRLEN foldlen,numlen;
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
- cp = toFOLD_uni(cp, tmpbuf, &foldlen);
-
- /* Quit before exceeding size limit */
- if (len + foldlen > U8_MAX) break;
-
- for (foldbuf = tmpbuf;
- foldlen;
- foldlen -= numlen)
- {
- cp = utf8_to_uvchr(foldbuf, &numlen);
- if (numlen > 0) {
- const STRLEN unilen = reguni(pRExC_state, cp, s);
- s += unilen;
- len += unilen;
- /* In EBCDIC the numlen and unilen can differ. */
- foldbuf += numlen;
- if (numlen >= foldlen)
- break;
- }
- else
- break; /* "Can't happen." */
- }
- }
+ /* Convert to notation the rest of the code understands */
+ sv_catpv(substitute_parse, "\\x{");
+ sv_catpvn(substitute_parse, RExC_parse, endchar - RExC_parse);
+ sv_catpv(substitute_parse, "}");
/* Point to the beginning of the next character in the sequence. */
RExC_parse = endchar + 1;
-
- /* Quit if no more characters */
- if (RExC_parse >= endbrace) break;
}
+ sv_catpv(substitute_parse, ")");
+ RExC_parse = SvPV(substitute_parse, len);
- if (SIZE_ONLY) {
- if (RExC_parse < endbrace) {
- ckWARNreg(RExC_parse - 1,
- "Using just the first characters returned by \\N{}");
- }
-
- RExC_size += STR_SZ(len);
- } else {
- STR_LEN(ret) = len;
- RExC_emit += STR_SZ(len);
+ /* Don't allow empty number */
+ if (len < 8) {
+ vFAIL("Invalid hexadecimal number in \\N{U+...}");
}
+ RExC_end = RExC_parse + len;
- RExC_parse = endbrace + 1;
+ /* The values are Unicode, and therefore not subject to recoding */
+ RExC_override_recoding = 1;
+
+ ret = reg(pRExC_state, 1, flagp, depth+1);
+
+ RExC_parse = endbrace;
+ RExC_end = orig_end;
+ RExC_override_recoding = 0;
- *flagp |= HASWIDTH; /* Not SIMPLE, as that causes the engine to fail
- with malformed in t/re/pat_advanced.t */
- RExC_parse --;
- Set_Node_Cur_Length(ret); /* MJD */
nextchar(pRExC_state);
}
RExC_parse++;
vFAIL("Quantifier follows nothing");
break;
- case LATIN_SMALL_LETTER_SHARP_S:
- case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
- case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
-#if UTF8_TWO_BYTE_HI_nocast(UPSILON_D_T) != UTF8_TWO_BYTE_HI_nocast(IOTA_D_T)
-#error The beginning utf8 byte of IOTA_D_T and UPSILON_D_T unexpectedly differ. Other instances in this code should have the case statement below.
- case UTF8_TWO_BYTE_HI_nocast(UPSILON_D_T):
-#endif
- do_foldchar:
- if (!LOC && FOLD) {
- U32 len,cp;
- len=0; /* silence a spurious compiler warning */
- if ((cp = what_len_TRICKYFOLD_safe(RExC_parse,RExC_end,UTF,len))) {
- *flagp |= HASWIDTH; /* could be SIMPLE too, but needs a handler in regexec.regrepeat */
- RExC_parse+=len-1; /* we get one from nextchar() as well. :-( */
- ret = reganode(pRExC_state, FOLDCHAR, cp);
- Set_Node_Length(ret, 1); /* MJD */
- nextchar(pRExC_state); /* kill whitespace under /x */
- return ret;
- }
- }
- goto outer_default;
case '\\':
/* Special Escapes
literal text handling code.
*/
switch ((U8)*++RExC_parse) {
- case LATIN_SMALL_LETTER_SHARP_S:
- case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
- case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
- goto do_foldchar;
/* Special Escapes */
case 'A':
RExC_seen_zerolen++;
Also this makes sure that things like /\N{BLAH}+/ and
\N{BLAH} being multi char Just Happen. dmq*/
++RExC_parse;
- ret= reg_namedseq(pRExC_state, NULL, flagp);
+ ret= reg_namedseq(pRExC_state, NULL, flagp, depth);
break;
case 'k': /* Handle \k<NAME> and \k'NAME' */
parse_named_seq:
/* FALL THROUGH */
default:
- outer_default:{
+
+ parse_start = RExC_parse - 1;
+
+ RExC_parse++;
+
+ defchar: {
+ typedef enum {
+ generic_char = 0,
+ char_s,
+ upsilon_1,
+ upsilon_2,
+ iota_1,
+ iota_2,
+ } char_state;
+ char_state latest_char_state = generic_char;
register STRLEN len;
register UV ender;
register char *p;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
regnode * orig_emit;
- parse_start = RExC_parse - 1;
-
- RExC_parse++;
-
- defchar:
ender = 0;
orig_emit = RExC_emit; /* Save the original output node position in
case we need to output a different node
if (RExC_flags & RXf_PMf_EXTENDED)
p = regwhite( pRExC_state, p );
switch ((U8)*p) {
- case LATIN_SMALL_LETTER_SHARP_S:
- case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
- case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
- if (LOC || !FOLD || !is_TRICKYFOLD_safe(p,RExC_end,UTF))
- goto normal_default;
case '^':
case '$':
case '.':
switch ((U8)*++p) {
/* These are all the special escapes. */
- case LATIN_SMALL_LETTER_SHARP_S:
- case UTF8_TWO_BYTE_HI_nocast(LATIN_SMALL_LETTER_SHARP_S):
- case UTF8_TWO_BYTE_HI_nocast(IOTA_D_T):
- if (LOC || !FOLD || !is_TRICKYFOLD_safe(p,RExC_end,UTF))
- goto normal_default;
case 'A': /* Start assertion */
case 'b': case 'B': /* Word-boundary assertion*/
case 'C': /* Single char !DANGEROUS! */
goto recode_encoding;
break;
recode_encoding:
- {
+ if (! RExC_override_recoding) {
SV* enc = PL_encoding;
ender = reg_recode((const char)(U8)ender, &enc);
if (!enc && SIZE_ONLY)
* putting it in a special node keeps regexec from having to
* deal with a non-utf8 multi-char fold */
if (FOLD
- && (ender > 255 || (! MORE_ASCII_RESTRICTED && ! LOC))
- && is_TRICKYFOLD_cp(ender))
+ && (ender > 255 || (! MORE_ASCII_RESTRICTED && ! LOC)))
{
- /* If is in middle of outputting characters into an
- * EXACTish node, go output what we have so far, and
- * position the parse so that this will be called again
- * immediately */
- if (len) {
- p = RExC_parse + len - 1;
- goto loopdone;
- }
- else {
+ /* We look for either side of the fold. For example \xDF
+ * folds to 'ss'. We look for both the single character
+ * \xDF and the sequence 'ss'. When we find something that
+ * could be one of those, we stop and flush whatever we
+ * have output so far into the EXACTish node that was being
+ * built. Then restore the input pointer to what it was.
+ * regatom will return that EXACT node, and will be called
+ * again, positioned so the first character is the one in
+ * question, which we return in a different node type.
+ * The multi-char folds are a sequence, so the occurrence
+ * of the first character in that sequence doesn't
+ * necessarily mean that what follows is the rest of the
+ * sequence. We keep track of that with a state machine,
+ * with the state being set to the latest character
+ * processed before the current one. Most characters will
+ * set the state to 0, but if one occurs that is part of a
+ * potential tricky fold sequence, the state is set to that
+ * character, and the next loop iteration sees if the state
+ * should progress towards the final folded-from character,
+ * or if it was a false alarm. If it turns out to be a
+ * false alarm, the character(s) will be output in a new
+ * EXACTish node, and join_exact() will later combine them.
+ * In the case of the 'ss' sequence, which is more common
+ * and more easily checked, some look-ahead is done to
+ * save time by ruling-out some false alarms */
+ switch (ender) {
+ default:
+ latest_char_state = generic_char;
+ break;
+ case 's':
+ case 'S':
+ case 0x17F: /* LATIN SMALL LETTER LONG S */
+ if (AT_LEAST_UNI_SEMANTICS) {
+ if (latest_char_state == char_s) { /* 'ss' */
+ ender = LATIN_SMALL_LETTER_SHARP_S;
+ goto do_tricky;
+ }
+ else if (p < RExC_end) {
+
+ /* Look-ahead at the next character. If it
+ * is also an s, we handle as a sharp s
+ * tricky regnode. */
+ if (*p == 's' || *p == 'S') {
+
+ /* But first flush anything in the
+ * EXACTish buffer */
+ if (len != 0) {
+ p = oldp;
+ goto loopdone;
+ }
+ p++; /* Account for swallowing this
+ 's' up */
+ ender = LATIN_SMALL_LETTER_SHARP_S;
+ goto do_tricky;
+ }
+ /* Here, the next character is not a
+ * literal 's', but still could
+ * evaluate to one if part of a \o{},
+ * \x or \OCTAL-DIGIT. The minimum
+ * length required for that is 4, eg
+ * \x53 or \123 */
+ else if (*p == '\\'
+ && p < RExC_end - 4
+ && (isDIGIT(*(p + 1))
+ || *(p + 1) == 'x'
+ || *(p + 1) == 'o' ))
+ {
+
+ /* Here, it could be an 's', too much
+ * bother to figure it out here. Flush
+ * the buffer if any; when come back
+ * here, set the state so know that the
+ * previous char was an 's' */
+ if (len != 0) {
+ latest_char_state = generic_char;
+ p = oldp;
+ goto loopdone;
+ }
+ latest_char_state = char_s;
+ break;
+ }
+ }
+ }
- /* Here we are ready to output our tricky fold
- * character. What's done is to pretend it's in a
- * [bracketed] class, and let the code that deals with
- * those handle it, as that code has all the
- * intelligence necessary. First save the current
- * parse state, get rid of the already allocated EXACT
- * node that the ANYOFV node will replace, and point
- * the parse to a buffer which we fill with the
- * character we want the regclass code to think is
- * being parsed */
- char* const oldregxend = RExC_end;
- char tmpbuf[2];
- RExC_emit = orig_emit;
- RExC_parse = tmpbuf;
- if (UTF) {
- tmpbuf[0] = UTF8_TWO_BYTE_HI(ender);
- tmpbuf[1] = UTF8_TWO_BYTE_LO(ender);
- RExC_end = RExC_parse + 2;
- }
- else {
- tmpbuf[0] = (char) ender;
- RExC_end = RExC_parse + 1;
- }
+ /* Here, can't be an 'ss' sequence, or at least not
+ * one that could fold to/from the sharp ss */
+ latest_char_state = generic_char;
+ break;
+ case 0x03C5: /* First char in upsilon series */
+ case 0x03A5: /* Also capital UPSILON, which folds to
+ 03C5, and hence exhibits the same
+ problem */
+ if (p < RExC_end - 4) { /* Need >= 4 bytes left */
+ latest_char_state = upsilon_1;
+ if (len != 0) {
+ p = oldp;
+ goto loopdone;
+ }
+ }
+ else {
+ latest_char_state = generic_char;
+ }
+ break;
+ case 0x03B9: /* First char in iota series */
+ case 0x0399: /* Also capital IOTA */
+ case 0x1FBE: /* GREEK PROSGEGRAMMENI folds to 3B9 */
+ case 0x0345: /* COMBINING GREEK YPOGEGRAMMENI folds
+ to 3B9 */
+ if (p < RExC_end - 4) {
+ latest_char_state = iota_1;
+ if (len != 0) {
+ p = oldp;
+ goto loopdone;
+ }
+ }
+ else {
+ latest_char_state = generic_char;
+ }
+ break;
+ case 0x0308:
+ if (latest_char_state == upsilon_1) {
+ latest_char_state = upsilon_2;
+ }
+ else if (latest_char_state == iota_1) {
+ latest_char_state = iota_2;
+ }
+ else {
+ latest_char_state = generic_char;
+ }
+ break;
+ case 0x301:
+ if (latest_char_state == upsilon_2) {
+ ender = GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS;
+ goto do_tricky;
+ }
+ else if (latest_char_state == iota_2) {
+ ender = GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS;
+ goto do_tricky;
+ }
+ latest_char_state = generic_char;
+ break;
- ret = regclass(pRExC_state,depth+1);
+ /* These are the tricky fold characters. Flush any
+ * buffer first. (When adding to this list, also should
+ * add them to fold_grind.t to make sure get tested) */
+ case GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS:
+ case GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS:
+ case LATIN_SMALL_LETTER_SHARP_S:
+ case LATIN_CAPITAL_LETTER_SHARP_S:
+ case 0x1FD3: /* GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA */
+ case 0x1FE3: /* GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA */
+ if (len != 0) {
+ p = oldp;
+ goto loopdone;
+ }
+ /* FALL THROUGH */
+ do_tricky: {
+ char* const oldregxend = RExC_end;
+ U8 tmpbuf[UTF8_MAXBYTES+1];
+
+ /* Here, we know we need to generate a special
+ * regnode, and 'ender' contains the tricky
+ * character. What's done is to pretend it's in a
+ * [bracketed] class, and let the code that deals
+ * with those handle it, as that code has all the
+ * intelligence necessary. First save the current
+ * parse state, get rid of the already allocated
+ * but empty EXACT node that the ANYOFV node will
+ * replace, and point the parse to a buffer which
+ * we fill with the character we want the regclass
+ * code to think is being parsed */
+ RExC_emit = orig_emit;
+ RExC_parse = (char *) tmpbuf;
+ if (UTF) {
+ U8 *d = uvchr_to_utf8(tmpbuf, ender);
+ *d = '\0';
+ RExC_end = (char *) d;
+ }
+ else { /* ender above 255 already excluded */
+ tmpbuf[0] = (U8) ender;
+ tmpbuf[1] = '\0';
+ RExC_end = RExC_parse + 1;
+ }
- /* Here, have parsed the buffer. Reset the parse to
- * the actual input, and return */
- RExC_end = oldregxend;
- RExC_parse = p - 1;
+ ret = regclass(pRExC_state,depth+1);
- Set_Node_Offset(ret, RExC_parse);
- Set_Node_Cur_Length(ret);
- nextchar(pRExC_state);
- *flagp |= HASWIDTH|SIMPLE;
- return ret;
+ /* Here, have parsed the buffer. Reset the parse to
+ * the actual input, and return */
+ RExC_end = oldregxend;
+ RExC_parse = p - 1;
+
+ Set_Node_Offset(ret, RExC_parse);
+ Set_Node_Cur_Length(ret);
+ nextchar(pRExC_state);
+ *flagp |= HASWIDTH|SIMPLE;
+ return ret;
+ }
}
}
}
len--;
}
- else
+ else {
REGC((char)ender, s++);
+ }
}
loopdone: /* Jumped to when encounters something that shouldn't be in
the node */
LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS);
break;
case LATIN_SMALL_LETTER_SHARP_S:
+ *invlist_ptr = add_cp_to_invlist(*invlist_ptr,
+ LATIN_CAPITAL_LETTER_SHARP_S);
/* Under /a, /d, and /u, this can match the two chars "ss" */
if (! MORE_ASCII_RESTRICTED) {
case 'I': case 'i':
case 'L': case 'l':
case 'T': case 't':
- /* These all are targets of multi-character folds, which can
- * occur with only non-Latin1 characters in the fold, so they
- * can match if the target string isn't UTF-8 */
- ANYOF_FLAGS(node) |= ANYOF_NONBITMAP_NON_UTF8;
- break;
case 'A': case 'a':
case 'H': case 'h':
case 'J': case 'j':
case 'N': case 'n':
case 'W': case 'w':
case 'Y': case 'y':
- /* These all are targets of multi-character folds, which occur
- * only with a non-Latin1 character as part of the fold, so
- * they can't match unless the target string is in UTF-8, so no
- * action here is necessary */
+ /* These all are targets of multi-character folds from code
+ * points that require UTF8 to express, so they can't match
+ * unless the target string is in UTF-8, so no action here is
+ * necessary, as regexec.c properly handles the general case
+ * for UTF-8 matching */
break;
default:
/* Use deprecated warning to increase the chances of this
IV namedclass;
char *rangebegin = NULL;
bool need_class = 0;
+ bool allow_full_fold = TRUE; /* Assume wants multi-char folding */
SV *listsv = NULL;
STRLEN initial_listsv_len = 0; /* Kind of a kludge to see if it is more
than just initialized. */
RExC_parse++;
if (!SIZE_ONLY)
ANYOF_FLAGS(ret) |= ANYOF_INVERT;
+
+ /* We have decided to not allow multi-char folds in inverted character
+ * classes, due to the confusion that can happen, especially with
+ * classes that are designed for a non-Unicode world: You have the
+ * peculiar case that:
+ "s s" =~ /^[^\xDF]+$/i => Y
+ "ss" =~ /^[^\xDF]+$/i => N
+ *
+ * See [perl #89750] */
+ allow_full_fold = FALSE;
}
if (SIZE_ONLY) {
RExC_size += ANYOF_SKIP;
-#ifdef ANYOF_ADD_LOC_SKIP
- if (LOC) {
- RExC_size += ANYOF_ADD_LOC_SKIP;
- }
-#endif
listsv = &PL_sv_undef; /* For code scanners: listsv always non-NULL. */
}
else {
RExC_emit += ANYOF_SKIP;
if (LOC) {
ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
-#ifdef ANYOF_ADD_LOC_SKIP
- RExC_emit += ANYOF_ADD_LOC_SKIP;
-#endif
}
ANYOF_BITMAP_ZERO(ret);
listsv = newSVpvs("# comment\n");
from earlier versions, OTOH that behaviour was broken
as well. */
UV v; /* value is register so we cant & it /grrr */
- if (reg_namedseq(pRExC_state, &v, NULL)) {
+ if (reg_namedseq(pRExC_state, &v, NULL, depth)) {
goto parseit;
}
value= v;
break;
}
recode_encoding:
- {
+ if (! RExC_override_recoding) {
SV* enc = PL_encoding;
value = reg_recode((const char)(U8)value, &enc);
if (!enc && SIZE_ONLY)
if (LOC && namedclass < ANYOF_MAX && ! need_class) {
need_class = 1;
if (SIZE_ONLY) {
-#ifdef ANYOF_CLASS_ADD_SKIP
- RExC_size += ANYOF_CLASS_ADD_SKIP;
-#endif
+ RExC_size += ANYOF_CLASS_SKIP - ANYOF_SKIP;
}
else {
-#ifdef ANYOF_CLASS_ADD_SKIP
- RExC_emit += ANYOF_CLASS_ADD_SKIP;
-#endif
+ RExC_emit += ANYOF_CLASS_SKIP - ANYOF_SKIP;
ANYOF_CLASS_ZERO(ret);
}
ANYOF_FLAGS(ret) |= ANYOF_CLASS;
}
else {
prevvalue = value; /* save the beginning of the range */
- if (*RExC_parse == '-' && RExC_parse+1 < RExC_end &&
- RExC_parse[1] != ']') {
+ if (RExC_parse+1 < RExC_end
+ && *RExC_parse == '-'
+ && RExC_parse[1] != ']')
+ {
RExC_parse++;
/* a bad range like \w-, [:word:]- ? */
/* Get its fold */
U8 foldbuf[UTF8_MAXBYTES_CASE+1];
STRLEN foldlen;
- const UV f = to_uni_fold(j, foldbuf, &foldlen);
+ const UV f =
+ _to_uni_fold_flags(j, foldbuf, &foldlen, allow_full_fold);
if (foldlen > (STRLEN)UNISKIP(f)) {
add_alternate(&unicode_alternate, foldbuf, foldlen);
end_multi_fold: ;
}
+
+ /* This is special-cased, as it is the only letter which
+ * has both a multi-fold and single-fold in Latin1. All
+ * the other chars that have single and multi-folds are
+ * always in utf8, and the utf8 folding algorithm catches
+ * them */
+ if (! LOC && j == LATIN_CAPITAL_LETTER_SHARP_S) {
+ stored += set_regclass_bit(pRExC_state,
+ ret,
+ LATIN_SMALL_LETTER_SHARP_S,
+ &l1_fold_invlist, &unicode_alternate);
+ }
}
else {
/* Single character fold. Add everything in its fold
/* Combine the two lists into one. */
if (l1_fold_invlist) {
if (nonbitmap) {
- nonbitmap = invlist_union(nonbitmap, l1_fold_invlist);
+ HV* temp = invlist_union(nonbitmap, l1_fold_invlist);
+ invlist_destroy(nonbitmap);
+ nonbitmap = temp;
+ invlist_destroy(l1_fold_invlist);
}
else {
nonbitmap = l1_fold_invlist;
* used later (regexec.c:S_reginclass()). */
av_store(av, 0, listsv);
av_store(av, 1, NULL);
- av_store(av, 2, MUTABLE_SV(unicode_alternate));
- if (unicode_alternate) { /* This node is variable length */
- OP(ret) = ANYOFV;
- }
+
+ /* Store any computed multi-char folds only if we are allowing
+ * them */
+ if (allow_full_fold) {
+ av_store(av, 2, MUTABLE_SV(unicode_alternate));
+ if (unicode_alternate) { /* This node is variable length */
+ OP(ret) = ANYOFV;
+ }
+ }
+ else {
+ av_store(av, 2, NULL);
+ }
rv = newRV_noinc(MUTABLE_SV(av));
n = add_data(pRExC_state, 1, "s");
RExC_rxi->data->data[n] = (void*)rv;
dVAR;
struct regexp *const r = (struct regexp *)SvANY(rx);
regexp_internal *reti;
- int len, npar;
+ int len;
RXi_GET_DECL(r,ri);
PERL_ARGS_ASSERT_REGDUPE_INTERNAL;
- npar = r->nparens+1;
len = ProgLen(ri);
Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode), char, regexp_internal);