X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c6b765375213e9d6dce25829a367fe4ef37da1a4..ea725ce6fd46ebc3bd7040373b9c0721af8813f8:/regcomp.c diff --git a/regcomp.c b/regcomp.c index ddf2539..a067af6 100644 --- a/regcomp.c +++ b/regcomp.c @@ -142,6 +142,8 @@ typedef struct RExC_state_t { 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) @@ -190,6 +192,8 @@ typedef struct RExC_state_t { #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) == '?') @@ -724,9 +728,24 @@ S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *c { PERL_ARGS_ASSERT_CL_ANYTHING; - ANYOF_CLASS_ZERO(cl); ANYOF_BITMAP_SETALL(cl); - 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) */ @@ -756,13 +775,15 @@ S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) Zero(cl, 1, struct regnode_charclass_class); cl->type = ANYOF; 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) @@ -812,6 +833,8 @@ S_cl_and(struct regnode_charclass_class *cl, } } 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 @@ -822,6 +845,7 @@ S_cl_and(struct regnode_charclass_class *cl, * with possible false positives */ if (! (and_with->flags & ANYOF_UNICODE_ALL)) { ARG_SET(cl, ANYOF_NONBITMAP_EMPTY); + cl->flags &= ~ANYOF_NONBITMAP_NON_UTF8; } } else if (! ANYOF_NONBITMAP(cl)) { @@ -829,14 +853,18 @@ S_cl_and(struct regnode_charclass_class *cl, /* 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 { @@ -846,13 +874,39 @@ S_cl_and(struct regnode_charclass_class *cl, } - /* 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(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with) { @@ -920,9 +974,6 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con 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 @@ -930,14 +981,24 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con * 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; } } @@ -2987,20 +3048,17 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } } 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, @@ -3238,6 +3296,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, 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 { @@ -3750,7 +3811,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, 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); @@ -3787,19 +3852,21 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, 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); + } } } } @@ -3827,7 +3894,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, 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); @@ -3864,7 +3931,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, 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); @@ -3882,24 +3949,25 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, break; case DIGIT: if (flags & SCF_DO_STCLASS_AND) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT); - for (value = 0; value < 256; value++) - if (!isDIGIT(value)) - ANYOF_BITMAP_CLEAR(data->start_class, value); + 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); + } } 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) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT); + if (!(data->start_class->flags & ANYOF_LOCALE)) + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT); for (value = 0; value < 256; value++) if (isDIGIT(value)) ANYOF_BITMAP_CLEAR(data->start_class, value); @@ -3907,11 +3975,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, 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); @@ -4470,6 +4536,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags) 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; @@ -4488,6 +4555,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags) 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 */ @@ -4544,11 +4612,15 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags) 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); } @@ -4561,6 +4633,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags) 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; @@ -5754,13 +5827,15 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) * 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) @@ -5769,30 +5844,9 @@ 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 @@ -5800,16 +5854,9 @@ S_invlist_len(pTHX_ HV* const invlist) { /* 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 @@ -5818,16 +5865,9 @@ S_invlist_max(pTHX_ HV* const invlist) /* 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 @@ -5837,14 +5877,7 @@ S_invlist_set_len(pTHX_ HV* const invlist, const UV len) 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 @@ -5857,13 +5890,10 @@ S_invlist_set_max(pTHX_ HV* const invlist, const UV max) 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 @@ -5875,22 +5905,12 @@ Perl__new_invlist(pTHX_ IV initial_size) * 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 @@ -5899,41 +5919,19 @@ S_invlist_destroy(pTHX_ HV* const invlist) { /* 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 @@ -5944,13 +5942,14 @@ S_invlist_trim(pTHX_ HV* const invlist) /* 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 @@ -6117,9 +6116,9 @@ S_invlist_union(pTHX_ HV* const a, HV* const 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 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. @@ -6129,12 +6128,12 @@ S_invlist_union(pTHX_ HV* const a, HV* const b) * 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--; } @@ -6182,7 +6181,8 @@ S_invlist_intersection(pTHX_ HV* const a, HV* const b) /* 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 @@ -6223,17 +6223,17 @@ S_invlist_intersection(pTHX_ HV* const a, HV* const b) 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))) { @@ -6262,19 +6262,32 @@ S_invlist_intersection(pTHX_ HV* const a, HV* const b) } } - /* 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); } @@ -6287,7 +6300,7 @@ S_invlist_intersection(pTHX_ HV* const a, HV* const 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); @@ -6640,6 +6653,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) SvIV_set(sv_dat, 1); } #ifdef DEBUGGING + /* Yes this does cause a memory leak in debugging Perls */ if (!av_store(RExC_paren_name_list, RExC_npar, SvREFCNT_inc(svname))) SvREFCNT_dec(svname); #endif @@ -6994,8 +7008,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) { U32 posflags = 0, negflags = 0; U32 *flagsp = &posflags; - bool has_charset_modifier = 0; - regex_charset cs = REGEX_DEPENDS_CHARSET; + char has_charset_modifier = '\0'; + regex_charset cs = (RExC_utf8 || RExC_uni_semantics) + ? REGEX_UNICODE_CHARSET + : REGEX_DEPENDS_CHARSET; while (*RExC_parse) { /* && strchr("iogcmsx", *RExC_parse) */ @@ -7004,39 +7020,51 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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 @@ -7046,8 +7074,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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)) { @@ -7398,7 +7442,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) 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; @@ -7417,7 +7463,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) 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 == ',') { @@ -7513,7 +7561,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) 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); @@ -7577,7 +7627,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } -/* 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 @@ -7620,13 +7670,10 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) 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; @@ -7739,168 +7786,55 @@ S_reg_namedseq(pTHX_ RExC_state_t *pRExC_state, UV *valuep, I32 *flagp) 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); } @@ -8063,27 +7997,6 @@ tryagain: 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 @@ -8098,10 +8011,6 @@ tryagain: 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++; @@ -8384,7 +8293,7 @@ tryagain: 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 and \k'NAME' */ parse_named_seq: @@ -8522,7 +8431,21 @@ tryagain: /* 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; @@ -8531,11 +8454,6 @@ tryagain: 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 @@ -8560,11 +8478,6 @@ tryagain: 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 '.': @@ -8589,11 +8502,6 @@ tryagain: 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! */ @@ -8720,7 +8628,7 @@ tryagain: 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) @@ -8764,55 +8672,205 @@ tryagain: * 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; + + /* 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; + } - ret = regclass(pRExC_state,depth+1); + ret = regclass(pRExC_state,depth+1); - /* Here, have parsed the buffer. Reset the parse to - * the actual input, and return */ - RExC_end = oldregxend; - RExC_parse = p - 1; + /* 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; + Set_Node_Offset(ret, RExC_parse); + Set_Node_Cur_Length(ret); + nextchar(pRExC_state); + *flagp |= HASWIDTH|SIMPLE; + return ret; + } } } @@ -8948,8 +9006,9 @@ tryagain: } len--; } - else + else { REGC((char)ender, s++); + } } loopdone: /* Jumped to when encounters something that shouldn't be in the node */ @@ -9329,14 +9388,16 @@ S_set_regclass_bit_fold(pTHX_ RExC_state_t *pRExC_state, regnode* node, const U8 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 /d and /u, this can match the two chars "ss" */ + /* Under /a, /d, and /u, this can match the two chars "ss" */ if (! MORE_ASCII_RESTRICTED) { add_alternate(alternate_ptr, (U8 *) "ss", 2); - /* And under /u, it can match even if the target is not - * utf8 */ - if (UNI_SEMANTICS) { + /* And under /u or /a, it can match even if the target is + * not utf8 */ + if (AT_LEAST_UNI_SEMANTICS) { ANYOF_FLAGS(node) |= ANYOF_NONBITMAP_NON_UTF8; } } @@ -9345,21 +9406,17 @@ S_set_regclass_bit_fold(pTHX_ RExC_state_t *pRExC_state, regnode* node, const U8 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 @@ -9448,6 +9505,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth) 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. */ @@ -9504,24 +9562,26 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth) 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"); @@ -9591,7 +9651,7 @@ parseit: 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; @@ -9716,7 +9776,7 @@ parseit: break; } recode_encoding: - { + if (! RExC_override_recoding) { SV* enc = PL_encoding; value = reg_recode((const char)(U8)value, &enc); if (!enc && SIZE_ONLY) @@ -9750,14 +9810,10 @@ parseit: 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; @@ -9896,8 +9952,10 @@ parseit: } 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:]- ? */ @@ -10042,7 +10100,8 @@ parseit: /* 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)) { @@ -10091,6 +10150,18 @@ parseit: 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 @@ -10150,7 +10221,10 @@ parseit: /* 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; @@ -10331,10 +10405,18 @@ parseit: * 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; @@ -11133,7 +11215,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) if (flags & ANYOF_NONBITMAP_NON_UTF8) sv_catpvs(sv, "{outside bitmap}"); - { + if (ANYOF_NONBITMAP(o)) { SV *lv; SV * const sw = regclass_swash(prog, o, FALSE, &lv, 0); @@ -11606,12 +11688,11 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) 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);