X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/b1e3e569b09fd7f24fa3e311cdf8e3d3d8ca931a..492a624f4a0c250e011c6b74a3403bfc885ec961:/regexec.c diff --git a/regexec.c b/regexec.c index 58fc358..76eb7f9 100644 --- a/regexec.c +++ b/regexec.c @@ -80,7 +80,7 @@ # include "regcomp.h" #endif -#define RF_tainted 1 /* tainted information used? */ +#define RF_tainted 1 /* tainted information used? e.g. locale */ #define RF_warned 2 /* warned about big count? */ #define RF_utf8 8 /* Pattern contains multibyte chars? */ @@ -94,9 +94,9 @@ #define STATIC static #endif -/* Valid for non-utf8 strings only: avoids the reginclass call if there are no - * complications: i.e., if everything matchable is straight forward in the - * bitmap */ +/* Valid for non-utf8 strings, non-ANYOFV nodes only: avoids the reginclass + * call if there are no complications: i.e., if everything matchable is + * straight forward in the bitmap */ #define REGINCLASS(prog,p,c) (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0,0) \ : ANYOF_BITMAP_TEST(p,*(c))) @@ -122,12 +122,26 @@ #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim)) /* these are unrolled below in the CCC_TRY_XXX defined */ -#define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \ - if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END +#ifdef EBCDIC + /* Often 'str' is a hard-coded utf8 string instead of utfebcdic. so just + * skip the check on EBCDIC platforms */ +# define LOAD_UTF8_CHARCLASS(class,str) LOAD_UTF8_CHARCLASS_NO_CHECK(class) +#else +# define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \ + if (!CAT2(PL_utf8_,class)) { \ + bool ok; \ + ENTER; save_re_context(); \ + ok=CAT2(is_utf8_,class)((const U8*)str); \ + assert(ok); assert(CAT2(PL_utf8_,class)); LEAVE; } } STMT_END +#endif /* Doesn't do an assert to verify that is correct */ #define LOAD_UTF8_CHARCLASS_NO_CHECK(class) STMT_START { \ - if (!CAT2(PL_utf8_,class)) { bool throw_away; ENTER; save_re_context(); throw_away = CAT2(is_utf8_,class)((const U8*)" "); LEAVE; } } STMT_END + if (!CAT2(PL_utf8_,class)) { \ + bool throw_away PERL_UNUSED_DECL; \ + ENTER; save_re_context(); \ + throw_away = CAT2(is_utf8_,class)((const U8*)" "); \ + LEAVE; } } STMT_END #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a") #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0") @@ -150,35 +164,6 @@ LOAD_UTF8_CHARCLASS_NO_CHECK(X_T); /* U+11A8 "\xe1\x86\xa8" */ \ LOAD_UTF8_CHARCLASS_NO_CHECK(X_V) /* U+1160 "\xe1\x85\xa0" */ -/* - We dont use PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS as the direct test - so that it is possible to override the option here without having to - rebuild the entire core. as we are required to do if we change regcomp.h - which is where PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS is defined. -*/ -#if PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS -#define BROKEN_UNICODE_CHARCLASS_MAPPINGS -#endif - -#ifdef BROKEN_UNICODE_CHARCLASS_MAPPINGS -#define LOAD_UTF8_CHARCLASS_PERL_WORD() LOAD_UTF8_CHARCLASS_ALNUM() -#define LOAD_UTF8_CHARCLASS_PERL_SPACE() LOAD_UTF8_CHARCLASS_SPACE() -#define LOAD_UTF8_CHARCLASS_POSIX_DIGIT() LOAD_UTF8_CHARCLASS_DIGIT() -#define RE_utf8_perl_word PL_utf8_alnum -#define RE_utf8_perl_space PL_utf8_space -#define RE_utf8_posix_digit PL_utf8_digit -#define perl_word alnum -#define perl_space space -#define posix_digit digit -#else -#define LOAD_UTF8_CHARCLASS_PERL_WORD() LOAD_UTF8_CHARCLASS(perl_word,"a") -#define LOAD_UTF8_CHARCLASS_PERL_SPACE() LOAD_UTF8_CHARCLASS(perl_space," ") -#define LOAD_UTF8_CHARCLASS_POSIX_DIGIT() LOAD_UTF8_CHARCLASS(posix_digit,"0") -#define RE_utf8_perl_word PL_utf8_perl_word -#define RE_utf8_perl_space PL_utf8_perl_space -#define RE_utf8_posix_digit PL_utf8_posix_digit -#endif - #define PLACEHOLDER /* Something for the preprocessor to grab onto */ /* The actual code for CCC_TRY, which uses several variables from the routine @@ -318,13 +303,13 @@ /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so we don't need this definition. */ #define IS_TEXT(rn) ( OP(rn)==EXACT || OP(rn)==REF || OP(rn)==NREF ) -#define IS_TEXTF(rn) ( (OP(rn)==EXACTFU || OP(rn)==EXACTF) || OP(rn)==REFF || OP(rn)==NREFF ) +#define IS_TEXTF(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFU_NO_TRIE || OP(rn)==EXACTFA || OP(rn)==EXACTF || OP(rn)==REFF || OP(rn)==NREFF ) #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL ) #else /* ... so we use this as its faster. */ #define IS_TEXT(rn) ( OP(rn)==EXACT ) -#define IS_TEXTFU(rn) ( OP(rn)==EXACTFU ) +#define IS_TEXTFU(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFU_NO_TRIE || OP(rn) == EXACTFA) #define IS_TEXTF(rn) ( OP(rn)==EXACTF ) #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL ) @@ -368,7 +353,8 @@ S_regcppush(pTHX_ I32 parenfloor) GET_RE_DEBUG_FLAGS_DECL; if (paren_elems_to_push < 0) - Perl_croak(aTHX_ "panic: paren_elems_to_push < 0"); + Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0", + paren_elems_to_push); if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems) Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf @@ -713,11 +699,26 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos, (IV)prog->check_end_shift); }); - if (flags & REXEC_SCREAM) { + if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) { I32 p = -1; /* Internal iterator of scream. */ I32 * const pp = data ? data->scream_pos : &p; + const MAGIC *mg; + bool found = FALSE; - if (PL_screamfirst[BmRARE(check)] >= 0 + assert(SvMAGICAL(sv)); + mg = mg_find(sv, PERL_MAGIC_study); + assert(mg); + + if (mg->mg_private == 1) { + found = ((U8 *)mg->mg_ptr)[BmRARE(check)] != (U8)~0; + } else if (mg->mg_private == 2) { + found = ((U16 *)mg->mg_ptr)[BmRARE(check)] != (U16)~0; + } else { + assert (mg->mg_private == 4); + found = ((U32 *)mg->mg_ptr)[BmRARE(check)] != (U32)~0; + } + + if (found || ( BmRARE(check) == '\n' && (BmPREVIOUS(check) == SvCUR(check) - 1) && SvTAIL(check) )) @@ -1076,7 +1077,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos, even for \b or \B. But (minlen? 1 : 0) below assumes that regstclass does not come from lookahead... */ /* If regstclass takes bytelength more than 1: If charlength==1, OK. - This leaves EXACTF, EXACTFU only, which are dealt with in find_byclass(). */ + This leaves EXACTF-ish only, which are dealt with in find_byclass(). */ const U8* const str = (U8*)STRING(progi->regstclass); const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT ? CHR_DIST(str+STR_LEN(progi->regstclass), str) @@ -1200,8 +1201,8 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \ uscan += len; \ len=0; \ } else { \ - uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \ - uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \ + uvc = to_utf8_fold( (U8 *) uc, foldbuf, &foldlen ); \ + len = UTF8SKIP(uc); \ foldlen -= UNISKIP( uvc ); \ uscan = foldbuf + UNISKIP( uvc ); \ } \ @@ -1240,43 +1241,11 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \ } \ } STMT_END -#define REXEC_FBC_EXACTISH_CHECK(CoNd) \ -{ \ - char *my_strend= (char *)strend; \ - if ( (CoNd) \ - && (ln == len || \ - foldEQ_utf8(s, &my_strend, 0, utf8_target, \ - m, NULL, ln, cBOOL(UTF_PATTERN))) \ - && (!reginfo || regtry(reginfo, &s)) ) \ - goto got_it; \ - else { \ - U8 foldbuf[UTF8_MAXBYTES_CASE+1]; \ - uvchr_to_utf8(tmpbuf, c); \ - f = to_utf8_fold(tmpbuf, foldbuf, &foldlen); \ - if ( f != c \ - && (f == c1 || f == c2) \ - && (ln == len || \ - foldEQ_utf8(s, &my_strend, 0, utf8_target,\ - m, NULL, ln, cBOOL(UTF_PATTERN)))\ - && (!reginfo || regtry(reginfo, &s)) ) \ - goto got_it; \ - } \ -} \ -s += len - #define REXEC_FBC_EXACTISH_SCAN(CoNd) \ STMT_START { \ - re_fold_t folder; \ - switch (OP(c)) { \ - case EXACTFU: folder = foldEQ_latin1; break; \ - case EXACTFL: folder = foldEQ_locale; break; \ - case EXACTF: folder = foldEQ; break; \ - default: \ - Perl_croak(aTHX_ "panic: Unexpected op %u", OP(c)); \ - } \ while (s <= e) { \ if ( (CoNd) \ - && (ln == 1 || folder(s, m, ln)) \ + && (ln == 1 || folder(s, pat_string, ln)) \ && (!reginfo || regtry(reginfo, &s)) ) \ goto got_it; \ s++; \ @@ -1447,15 +1416,19 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, { dVAR; const I32 doevery = (prog->intflags & PREGf_SKIP) == 0; - char *m; + char *pat_string; /* The pattern's exactish string */ + char *pat_end; /* ptr to end char of pat_string */ + re_fold_t folder; /* Function for computing non-utf8 folds */ + const U8 *fold_array; /* array for folding ords < 256 */ STRLEN ln; STRLEN lnc; register STRLEN uskip; - unsigned int c1; - unsigned int c2; + U8 c1; + U8 c2; char *e; register I32 tmp = 1; /* Scratch variable? */ register const bool utf8_target = PL_reg_match_utf8; + UV utf8_fold_flags = 0; RXi_GET_DECL(prog,progi); PERL_ARGS_ASSERT_FIND_BYCLASS; @@ -1470,23 +1443,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, reginclass(prog, c, (U8*)s, &inclasslen, utf8_target)); } else { - while (s < strend) { - STRLEN skip = 1; - - if (REGINCLASS(prog, c, (U8*)s) || - (ANYOF_FOLD_SHARP_S(c, s, strend) && - /* The assignment of 2 is intentional: - * for the folded sharp s, the skip is 2. */ - (skip = SHARP_S_SKIP))) { - if (tmp && (!reginfo || regtry(reginfo, &s))) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += skip; - } + REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s)); } break; case CANY: @@ -1497,134 +1454,148 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, tmp = doevery; ); break; - case EXACTFU: + + case EXACTFA: + if (UTF_PATTERN || utf8_target) { + utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII; + goto do_exactf_utf8; + } + fold_array = PL_fold_latin1; /* Latin1 folds are not affected by */ + folder = foldEQ_latin1; /* /a, except the sharp s one which */ + goto do_exactf_non_utf8; /* isn't dealt with by these */ + case EXACTF: - m = STRING(c); - ln = STR_LEN(c); /* length to match in octets/bytes */ - lnc = (I32) ln; /* length to match in characters */ + if (utf8_target) { + + /* regcomp.c already folded this if pattern is in UTF-8 */ + utf8_fold_flags = 0; + goto do_exactf_utf8; + } + fold_array = PL_fold; + folder = foldEQ; + goto do_exactf_non_utf8; + + case EXACTFL: + if (UTF_PATTERN || utf8_target) { + utf8_fold_flags = FOLDEQ_UTF8_LOCALE; + goto do_exactf_utf8; + } + fold_array = PL_fold_locale; + folder = foldEQ_locale; + goto do_exactf_non_utf8; + + case EXACTFU_SS: if (UTF_PATTERN) { - STRLEN ulen1, ulen2; - U8 *sm = (U8 *) m; - U8 tmpbuf1[UTF8_MAXBYTES_CASE+1]; - U8 tmpbuf2[UTF8_MAXBYTES_CASE+1]; - /* used by commented-out code below */ - /*const U32 uniflags = UTF8_ALLOW_DEFAULT;*/ - - /* XXX: Since the node will be case folded at compile - time this logic is a little odd, although im not - sure that its actually wrong. --dmq */ - - c1 = to_utf8_lower((U8*)m, tmpbuf1, &ulen1); - c2 = to_utf8_upper((U8*)m, tmpbuf2, &ulen2); - - /* XXX: This is kinda strange. to_utf8_XYZ returns the - codepoint of the first character in the converted - form, yet originally we did the extra step. - No tests fail by commenting this code out however - so Ive left it out. -- dmq. - - c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, - 0, uniflags); - c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE, - 0, uniflags); - */ - - lnc = 0; - while (sm < ((U8 *) m + ln)) { - lnc++; - sm += UTF8SKIP(sm); - } + utf8_fold_flags = FOLDEQ_S2_ALREADY_FOLDED; + } + goto do_exactf_utf8; + + case EXACTFU_NO_TRIE: + case EXACTFU: + if (UTF_PATTERN || utf8_target) { + utf8_fold_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0; + goto do_exactf_utf8; + } + + /* Any 'ss' in the pattern should have been replaced by regcomp, + * so we don't have to worry here about this single special case + * in the Latin1 range */ + fold_array = PL_fold_latin1; + folder = foldEQ_latin1; + + /* FALL THROUGH */ + + do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there + are no glitches with fold-length differences + between the target string and pattern */ + + /* The idea in the non-utf8 EXACTF* cases is to first find the + * first character of the EXACTF* node and then, if necessary, + * case-insensitively compare the full text of the node. c1 is the + * first character. c2 is its fold. This logic will not work for + * Unicode semantics and the german sharp ss, which hence should + * not be compiled into a node that gets here. */ + pat_string = STRING(c); + ln = STR_LEN(c); /* length to match in octets/bytes */ + + /* We know that we have to match at least 'ln' bytes (which is the + * same as characters, since not utf8). If we have to match 3 + * characters, and there are only 2 availabe, we know without + * trying that it will fail; so don't start a match past the + * required minimum number from the far end */ + e = HOP3c(strend, -((I32)ln), s); + + if (!reginfo && e < s) { + e = s; /* Due to minlen logic of intuit() */ + } + + c1 = *pat_string; + c2 = fold_array[c1]; + if (c1 == c2) { /* If char and fold are the same */ + REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1); } else { - c1 = *(U8*)m; - if (utf8_target || OP(c) == EXACTFU) { - - /* Micro sign folds to GREEK SMALL LETTER MU; - LATIN_SMALL_LETTER_SHARP_S folds to 'ss', and this sets - c2 to the first 's' of the pair, and the code below will - look for others */ - c2 = (c1 == MICRO_SIGN) - ? GREEK_SMALL_LETTER_MU - : (c1 == LATIN_SMALL_LETTER_SHARP_S) - ? 's' - : PL_fold_latin1[c1]; - } else c2 = PL_fold[c1]; + REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2); } - goto do_exactf; - case EXACTFL: - m = STRING(c); - ln = STR_LEN(c); - lnc = (I32) ln; - c1 = *(U8*)m; - c2 = PL_fold_locale[c1]; - do_exactf: + break; + + do_exactf_utf8: + { + unsigned expansion; + + + /* If one of the operands is in utf8, we can't use the simpler + * folding above, due to the fact that many different characters + * can have the same fold, or portion of a fold, or different- + * length fold */ + pat_string = STRING(c); + ln = STR_LEN(c); /* length to match in octets/bytes */ + pat_end = pat_string + ln; + lnc = (UTF_PATTERN) /* length to match in characters */ + ? utf8_length((U8 *) pat_string, (U8 *) pat_end) + : ln; + + /* We have 'lnc' characters to match in the pattern, but because of + * multi-character folding, each character in the target can match + * up to 3 characters (Unicode guarantees it will never exceed + * this) if it is utf8-encoded; and up to 2 if not (based on the + * fact that the Latin 1 folds are already determined, and the + * only multi-char fold in that range is the sharp-s folding to + * 'ss'. Thus, a pattern character can match as little as 1/3 of a + * string character. Adjust lnc accordingly, rounding up, so that + * if we need to match at least 4+1/3 chars, that really is 5. */ + expansion = (utf8_target) ? UTF8_MAX_FOLD_CHAR_EXPAND : 2; + lnc = (lnc + expansion - 1) / expansion; + + /* As in the non-UTF8 case, if we have to match 3 characters, and + * only 2 are left, it's guaranteed to fail, so don't start a + * match that would require us to go beyond the end of the string + */ e = HOP3c(strend, -((I32)lnc), s); - if (!reginfo && e < s) + if (!reginfo && e < s) { e = s; /* Due to minlen logic of intuit() */ + } - /* The idea in the EXACTF* cases is to first find the - * first character of the EXACTF* node and then, if - * necessary, case-insensitively compare the full - * text of the node. The c1 and c2 are the first - * characters (though in Unicode it gets a bit - * more complicated because there are more cases - * than just upper and lower: one needs to use - * the so-called folding case for case-insensitive - * matching (called "loose matching" in Unicode). - * foldEQ_utf8() will do just that. */ - - if (utf8_target || UTF_PATTERN) { - UV c, f; - U8 tmpbuf [UTF8_MAXBYTES+1]; - STRLEN len = 1; - STRLEN foldlen; - const U32 uniflags = UTF8_ALLOW_DEFAULT; - if (c1 == c2) { - /* Upper and lower of 1st char are equal - - * probably not a "letter". */ - while (s <= e) { - if (utf8_target) { - c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len, - uniflags); - } else { - c = *((U8*)s); - } - REXEC_FBC_EXACTISH_CHECK(c == c1); - } - } - else { - while (s <= e) { - if (utf8_target) { - c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len, - uniflags); - } else { - c = *((U8*)s); - } - - /* Handle some of the three Greek sigmas cases. - * Note that not all the possible combinations - * are handled here: some of them are handled - * by the standard folding rules, and some of - * them (the character class or ANYOF cases) - * are handled during compiletime in - * regexec.c:S_regclass(). */ - if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA || - c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA) - c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA; - - REXEC_FBC_EXACTISH_CHECK(c == c1 || c == c2); - } + /* XXX Note that we could recalculate e to stop the loop earlier, + * as the worst case expansion above will rarely be met, and as we + * go along we would usually find that e moves further to the left. + * This would happen only after we reached the point in the loop + * where if there were no expansion we should fail. Unclear if + * worth the expense */ + + while (s <= e) { + char *my_strend= (char *)strend; + if (foldEQ_utf8_flags(s, &my_strend, 0, utf8_target, + pat_string, NULL, ln, cBOOL(UTF_PATTERN), utf8_fold_flags) + && (!reginfo || regtry(reginfo, &s)) ) + { + goto got_it; } - } - else { - /* Neither pattern nor string are UTF8 */ - if (c1 == c2) - REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1); - else - REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2); + s += (utf8_target) ? UTF8SKIP(s) : 1; } break; + } case BOUNDL: PL_reg_flags |= RF_tainted; FBC_BOUND(isALNUM_LC, @@ -1675,15 +1646,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; case ALNUMU: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_WORD(), - swash_fetch(RE_utf8_perl_word,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_ALNUM(), + swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target), isWORDCHAR_L1((U8) *s) ); break; case ALNUM: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_WORD(), - swash_fetch(RE_utf8_perl_word,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_ALNUM(), + swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target), isWORDCHAR((U8) *s) ); break; @@ -1694,15 +1665,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; case NALNUMU: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_WORD(), - swash_fetch(RE_utf8_perl_word,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_ALNUM(), + !swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target), ! isWORDCHAR_L1((U8) *s) ); break; case NALNUM: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_WORD(), - !swash_fetch(RE_utf8_perl_word, (U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_ALNUM(), + !swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target), ! isALNUM(*s) ); break; @@ -1720,15 +1691,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; case SPACEU: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_SPACE(), - *s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_SPACE(), + *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target), isSPACE_L1((U8) *s) ); break; case SPACE: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_SPACE(), - *s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_SPACE(), + *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target), isSPACE((U8) *s) ); break; @@ -1745,15 +1716,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; case NSPACEU: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_SPACE(), - !( *s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target)), + LOAD_UTF8_CHARCLASS_SPACE(), + !( *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)), ! isSPACE_L1((U8) *s) ); break; case NSPACE: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_PERL_SPACE(), - !(*s == ' ' || swash_fetch(RE_utf8_perl_space,(U8*)s, utf8_target)), + LOAD_UTF8_CHARCLASS_SPACE(), + !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)), ! isSPACE((U8) *s) ); break; @@ -1771,8 +1742,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; case DIGIT: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_POSIX_DIGIT(), - swash_fetch(RE_utf8_posix_digit,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_DIGIT(), + swash_fetch(PL_utf8_digit,(U8*)s, utf8_target), isDIGIT(*s) ); break; @@ -1789,8 +1760,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; case NDIGIT: REXEC_FBC_CSCAN_PRELOAD( - LOAD_UTF8_CHARCLASS_POSIX_DIGIT(), - !swash_fetch(RE_utf8_posix_digit,(U8*)s, utf8_target), + LOAD_UTF8_CHARCLASS_DIGIT(), + !swash_fetch(PL_utf8_digit,(U8*)s, utf8_target), !isDIGIT(*s) ); break; @@ -2274,8 +2245,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre /*XXX: The s-- is almost definitely wrong here under unicode - demeprhq*/ s--; } - /* We can use a more efficient search as newlines are the same in unicode as they are in latin */ - while (s < end) { + /* We can use a more efficient search as newlines are the same in unicode as they are in latin */ + while (s <= end) { /* note it could be possible to match at the end of the string */ if (*s++ == '\n') { /* don't need PL_utf8skip here */ if (regtry(®info, &s)) goto got_it; @@ -2383,7 +2354,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre dontbother = end_shift; strend = HOPc(strend, -dontbother); while ( (s <= last) && - ((flags & REXEC_SCREAM) + ((flags & REXEC_SCREAM) && SvSCREAM(sv) ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg, end_shift, &scream_pos, 0)) : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)), @@ -2462,7 +2433,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog); float_real = utf8_target ? prog->float_utf8 : prog->float_substr; - if (flags & REXEC_SCREAM) { + if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) { last = screaminstr(sv, float_real, s - strbeg, end_shift, &scream_pos, 1); /* last one */ if (!last) @@ -2656,7 +2627,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos) /* This is safe against NULLs: */ ReREFCNT_dec(PM_GETRE(PL_reg_curpm)); /* PM_reg_curpm owns a reference to this regexp. */ - ReREFCNT_inc(rx); + (void)ReREFCNT_inc(rx); #endif PM_SETRE(PL_reg_curpm, rx); PL_reg_oldcurpm = PL_curpm; @@ -3691,54 +3662,54 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) re_fold_t folder; const U8 * fold_array; const char * s; + U32 fold_utf8_flags; PL_reg_flags |= RF_tainted; folder = foldEQ_locale; fold_array = PL_fold_locale; + fold_utf8_flags = FOLDEQ_UTF8_LOCALE; goto do_exactf; + case EXACTFU_SS: + case EXACTFU_NO_TRIE: case EXACTFU: folder = foldEQ_latin1; fold_array = PL_fold_latin1; + fold_utf8_flags = (UTF_PATTERN) ? FOLDEQ_S1_ALREADY_FOLDED : 0; + goto do_exactf; + + case EXACTFA: + folder = foldEQ_latin1; + fold_array = PL_fold_latin1; + fold_utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII; goto do_exactf; case EXACTF: folder = foldEQ; fold_array = PL_fold; + fold_utf8_flags = 0; do_exactf: s = STRING(scan); ln = STR_LEN(scan); - if (utf8_target || UTF_PATTERN) { - /* Either target or the pattern are utf8. */ + if (utf8_target || UTF_PATTERN || state_num == EXACTFU_SS) { + /* Either target or the pattern are utf8, or has the issue where + * the fold lengths may differ. */ const char * const l = locinput; char *e = PL_regeol; - if (! foldEQ_utf8(s, 0, ln, cBOOL(UTF_PATTERN), - l, &e, 0, utf8_target)) { - /* One more case for the sharp s: - * pack("U0U*", 0xDF) =~ /ss/i, - * the 0xC3 0x9F are the UTF-8 - * byte sequence for the U+00DF. */ - - if (!(utf8_target && - toLOWER(s[0]) == 's' && - ln >= 2 && - toLOWER(s[1]) == 's' && - (U8)l[0] == 0xC3 && - e - l >= 2 && - (U8)l[1] == 0x9F)) - sayNO; + if (! foldEQ_utf8_flags(s, 0, ln, cBOOL(UTF_PATTERN), + l, &e, 0, utf8_target, fold_utf8_flags)) + { + sayNO; } locinput = e; nextchr = UCHARAT(locinput); break; } - /* Neither the target and the pattern are utf8. */ - - /* Inline the first character, for speed. */ + /* Neither the target nor the pattern are utf8 */ if (UCHARAT(s) != nextchr && UCHARAT(s) != fold_array[nextchr]) { @@ -3767,7 +3738,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) case NBOUNDU: case NBOUNDA: /* was last char in word? */ - if (utf8_target && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET) { + if (utf8_target + && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET + && FLAGS(scan) != REGEX_ASCII_MORE_RESTRICTED_CHARSET) + { if (locinput == PL_bostr) ln = '\n'; else { @@ -3814,6 +3788,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) n = isALNUM(nextchr); break; case REGEX_ASCII_RESTRICTED_CHARSET: + case REGEX_ASCII_MORE_RESTRICTED_CHARSET: ln = isWORDCHAR_A(ln); n = isWORDCHAR_A(nextchr); break; @@ -3856,18 +3831,18 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) ALNUML, NALNUML, isALNUM_LC, isALNUM_LC_utf8, ALNUMU, NALNUMU, isWORDCHAR_L1, ALNUMA, NALNUMA, isWORDCHAR_A, - perl_word, "a"); + alnum, "a"); CCC_TRY_U(SPACE, NSPACE, isSPACE, SPACEL, NSPACEL, isSPACE_LC, isSPACE_LC_utf8, SPACEU, NSPACEU, isSPACE_L1, SPACEA, NSPACEA, isSPACE_A, - perl_space, " "); + space, " "); CCC_TRY(DIGIT, NDIGIT, isDIGIT, DIGITL, NDIGITL, isDIGIT_LC, isDIGIT_LC_utf8, DIGITA, NDIGITA, isDIGIT_A, - posix_digit, "0"); + digit, "0"); case CLUMP: /* Match \X: logical Unicode character. This is defined as a Unicode extended Grapheme Cluster */ @@ -3913,17 +3888,17 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) L* (L | LVT T* | V V* T* | LV V* T*) That means that if we have seen any L's at all we can quit - there, but if the next character is a LVT, a V or and LV we + there, but if the next character is an LVT, a V, or an LV we should keep going. There is a subtlety with Prepend* which showed up in testing. Note that the Begin, and only the Begin is required in: | Prepend* Begin Extend* - Also, Begin contains '! Control'. A Prepend must be a '! - Control', which means it must be a Begin. What it comes down to - is that if we match Prepend* and then find no suitable Begin - afterwards, that if we backtrack the last Prepend, that one will - be a suitable Begin. + Also, Begin contains '! Control'. A Prepend must be a + '! Control', which means it must also be a Begin. What it + comes down to is that if we match Prepend* and then find no + suitable Begin afterwards, that if we backtrack the last + Prepend, that one will be a suitable Begin. */ if (locinput >= PL_regeol) @@ -3933,7 +3908,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) /* Match either CR LF or '.', as all the other possibilities * require utf8 */ locinput++; /* Match the . or CR */ - if (nextchr == '\r' + if (nextchr == '\r' /* And if it was CR, and the next is LF, + match the LF */ && locinput < PL_regeol && UCHARAT(locinput) == '\n') locinput++; } @@ -4087,34 +4063,47 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) named buffers just convert to the equivalent numbered and pretend they were called as the corresponding numbered buffer op. */ - /* don't initialize these, it makes C++ unhappy */ + /* don't initialize these in the declaration, it makes C++ + unhappy */ char *s; char type; re_fold_t folder; const U8 *fold_array; + UV utf8_fold_flags; PL_reg_flags |= RF_tainted; folder = foldEQ_locale; fold_array = PL_fold_locale; type = REFFL; + utf8_fold_flags = FOLDEQ_UTF8_LOCALE; + goto do_nref; + + case NREFFA: + folder = foldEQ_latin1; + fold_array = PL_fold_latin1; + type = REFFA; + utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII; goto do_nref; case NREFFU: folder = foldEQ_latin1; fold_array = PL_fold_latin1; type = REFFU; + utf8_fold_flags = 0; goto do_nref; case NREFF: folder = foldEQ; fold_array = PL_fold; type = REFF; + utf8_fold_flags = 0; goto do_nref; case NREF: type = REF; folder = NULL; fold_array = NULL; + utf8_fold_flags = 0; do_nref: /* For the named back references, find the corresponding buffer @@ -4130,21 +4119,31 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) PL_reg_flags |= RF_tainted; folder = foldEQ_locale; fold_array = PL_fold_locale; + utf8_fold_flags = FOLDEQ_UTF8_LOCALE; + goto do_ref; + + case REFFA: + folder = foldEQ_latin1; + fold_array = PL_fold_latin1; + utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII; goto do_ref; case REFFU: folder = foldEQ_latin1; fold_array = PL_fold_latin1; + utf8_fold_flags = 0; goto do_ref; case REFF: folder = foldEQ; fold_array = PL_fold; + utf8_fold_flags = 0; goto do_ref; case REF: folder = NULL; fold_array = NULL; + utf8_fold_flags = 0; do_ref: type = OP(scan); @@ -4160,10 +4159,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) s = PL_bostr + ln; if (type != REF /* REF can do byte comparison */ - && (utf8_target - || (type == REFFU - && (*s == (char) LATIN_SMALL_LETTER_SHARP_S - || *locinput == (char) LATIN_SMALL_LETTER_SHARP_S)))) + && (utf8_target || type == REFFU)) { /* XXX handle REFFL better */ char * limit = PL_regeol; @@ -4172,8 +4168,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) * not going off the end given by PL_regeol, and returns in * limit upon success, how much of the current input was * matched */ - if (! foldEQ_utf8(s, NULL, PL_regoffs[n].end - ln, utf8_target, - locinput, &limit, 0, utf8_target)) + if (! foldEQ_utf8_flags(s, NULL, PL_regoffs[n].end - ln, utf8_target, + locinput, &limit, 0, utf8_target, utf8_fold_flags)) { sayNO; } @@ -4275,6 +4271,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) PL_op = (OP_4tree*)rexi->data->data[n]; DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) ); + /* wrap the call in two SAVECOMPPADs. This ensures that + * when the save stack is eventually unwound, all the + * accumulated SAVEt_CLEARSV's will be processed with + * interspersed SAVEt_COMPPAD's to ensure that lexicals + * are cleared in the right pad */ + SAVECOMPPAD(); PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]); PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr; @@ -4295,6 +4297,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) Copy(&saved_state, &PL_reg_state, 1, struct re_save_state); PL_op = oop; + SAVECOMPPAD(); PAD_RESTORE_LOCAL(old_comppad); PL_curcop = ocurcop; PL_regeol = saved_regeol; @@ -4721,7 +4724,10 @@ NULL /* First just match a string of min A's. */ if (n < min) { + ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor); cur_curlyx->u.curlyx.lastloc = locinput; + REGCP_SET(ST.lastcp); + PUSH_STATE_GOTO(WHILEM_A_pre, A); /* NOTREACHED */ } @@ -4827,10 +4833,10 @@ NULL /* NOTREACHED */ case WHILEM_A_min_fail: /* just failed to match A in a minimal match */ - REGCP_UNWIND(ST.lastcp); - regcppop(rex); /* FALL THROUGH */ case WHILEM_A_pre_fail: /* just failed to match even minimal A */ + REGCP_UNWIND(ST.lastcp); + regcppop(rex); cur_curlyx->u.curlyx.lastloc = ST.save_lastloc; cur_curlyx->u.curlyx.count--; CACHEsayNO; @@ -4850,8 +4856,9 @@ NULL && !(PL_reg_flags & RF_warned)) { PL_reg_flags |= RF_warned; - Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded", - "Complex regular subexpression recursion", + Perl_warner(aTHX_ packWARN(WARN_REGEXP), + "Complex regular subexpression recursion limit (%d) " + "exceeded", REG_INFTY - 1); } @@ -4874,8 +4881,8 @@ NULL { PL_reg_flags |= RF_warned; Perl_warner(aTHX_ packWARN(WARN_REGEXP), - "%s limit (%d) exceeded", - "Complex regular subexpression recursion", + "Complex regular subexpression recursion " + "limit (%d) exceeded", REG_INFTY - 1); } cur_curlyx->u.curlyx.count--; @@ -5076,6 +5083,9 @@ NULL ST.c1 = (U8)*STRING(text_node); switch (OP(text_node)) { case EXACTF: ST.c2 = PL_fold[ST.c1]; break; + case EXACTFA: + case EXACTFU_SS: + case EXACTFU_NO_TRIE: case EXACTFU: ST.c2 = PL_fold_latin1[ST.c1]; break; case EXACTFL: ST.c2 = PL_fold_locale[ST.c1]; break; default: ST.c2 = ST.c1; @@ -5229,6 +5239,9 @@ NULL ST.c1 = *s; switch (OP(text_node)) { case EXACTF: ST.c2 = PL_fold[ST.c1]; break; + case EXACTFA: + case EXACTFU_SS: + case EXACTFU_NO_TRIE: case EXACTFU: ST.c2 = PL_fold_latin1[ST.c1]; break; case EXACTFL: ST.c2 = PL_fold_locale[ST.c1]; break; default: ST.c2 = ST.c1; break; @@ -5480,7 +5493,7 @@ NULL rex = (struct regexp *)SvANY(rex_sv); rexi = RXi_GET(rex); cur_curlyx = cur_eval->u.eval.prev_curlyx; - ReREFCNT_inc(rex_sv); + (void)ReREFCNT_inc(rex_sv); st->u.eval.cp = regcppush(0); /* Save *all* the positions. */ /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */ @@ -5697,27 +5710,6 @@ NULL sayNO; /* NOTREACHED */ #undef ST - case FOLDCHAR: - n = ARG(scan); - if ( n == (U32)what_len_TRICKYFOLD(locinput,utf8_target,ln) ) { - locinput += ln; - } else if ( LATIN_SMALL_LETTER_SHARP_S == n && !utf8_target && !UTF_PATTERN ) { - sayNO; - } else { - U8 folded[UTF8_MAXBYTES_CASE+1]; - STRLEN foldlen; - const char * const l = locinput; - char *e = PL_regeol; - to_uni_fold(n, folded, &foldlen); - - if (! foldEQ_utf8((const char*) folded, 0, foldlen, 1, - l, &e, 0, utf8_target)) { - sayNO; - } - locinput = e; - } - nextchr = UCHARAT(locinput); - break; case LNBREAK: if ((n=is_LNBREAK(locinput,utf8_target))) { locinput += n; @@ -5728,6 +5720,8 @@ NULL #define CASE_CLASS(nAmE) \ case nAmE: \ + if (locinput >= PL_regeol) \ + sayNO; \ if ((n=is_##nAmE(locinput,utf8_target))) { \ locinput += n; \ nextchr = UCHARAT(locinput); \ @@ -5735,6 +5729,8 @@ NULL sayNO; \ break; \ case N##nAmE: \ + if (locinput >= PL_regeol) \ + sayNO; \ if ((n=is_##nAmE(locinput,utf8_target))) { \ sayNO; \ } else { \ @@ -5949,6 +5945,7 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth) register char *loceol = PL_regeol; register I32 hardcount = 0; register bool utf8_target = PL_reg_match_utf8; + UV utf8_flags; #ifndef DEBUGGING PERL_UNUSED_ARG(depth); #endif @@ -6008,7 +6005,7 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth) /* Here, the string is utf8, and the pattern char is different * in utf8 than not, so can't compare them directly. Outside the - * loop, find find the two utf8 bytes that represent c, and then + * loop, find the two utf8 bytes that represent c, and then * look for those in sequence in the utf8 string */ U8 high = UTF8_TWO_BYTE_HI(c); U8 low = UTF8_TWO_BYTE_LO(c); @@ -6024,28 +6021,36 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth) } } break; + case EXACTFA: + utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII; + goto do_exactf; + case EXACTFL: PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ + utf8_flags = FOLDEQ_UTF8_LOCALE; + goto do_exactf; + case EXACTF: + utf8_flags = 0; + goto do_exactf; + + case EXACTFU_SS: + case EXACTFU_NO_TRIE: case EXACTFU: + utf8_flags = (UTF_PATTERN) ? FOLDEQ_S2_ALREADY_FOLDED : 0; /* The comments for the EXACT case above apply as well to these fold * ones */ + do_exactf: c = (U8)*STRING(p); assert(! UTF_PATTERN || UNI_IS_INVARIANT(c)); - if (utf8_target) { /* Use full Unicode fold matching */ - - /* For the EXACTFL case, It doesn't really make sense to compare - * locale and utf8, but it is best we can do. The documents warn - * against mixing them */ - + if (utf8_target || OP(p) == EXACTFU_SS) { /* Use full Unicode fold matching */ char *tmpeol = loceol; while (hardcount < max - && foldEQ_utf8(scan, &tmpeol, 0, utf8_target, - STRING(p), NULL, 1, cBOOL(UTF_PATTERN))) + && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target, + STRING(p), NULL, 1, cBOOL(UTF_PATTERN), utf8_flags)) { scan = tmpeol; tmpeol = loceol; @@ -6071,6 +6076,8 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth) * fold matching. */ switch (OP(p)) { case EXACTF: folded = PL_fold[c]; break; + case EXACTFA: + case EXACTFU_NO_TRIE: case EXACTFU: folded = PL_fold_latin1[c]; break; case EXACTFL: folded = PL_fold_locale[c]; break; default: Perl_croak(aTHX_ "panic: Unexpected op %u", OP(p)); @@ -6471,20 +6478,41 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth) #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) /* -- regclass_swash - prepare the utf8 swash -*/ - +- regclass_swash - prepare the utf8 swash. Wraps the shared core version to +create a copy so that changes the caller makes won't change the shared one + */ SV * Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) { + PERL_ARGS_ASSERT_REGCLASS_SWASH; + return newSVsv(core_regclass_swash(prog, node, doinit, listsvp, altsvp)); +} +#endif + +STATIC SV * +S_core_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) +{ + /* Returns the swash for the input 'node' in the regex 'prog'. + * If is true, will attempt to create the swash if not already + * done. + * If is non-null, will return the swash initialization string in + * it. + * If is non-null, will return the alternates to the regular swash + * in it + * Tied intimately to how regcomp.c sets up the data structure */ + dVAR; SV *sw = NULL; SV *si = NULL; SV *alt = NULL; + SV* invlist = NULL; + RXi_GET_DECL(prog,progi); const struct reg_data * const data = prog ? progi->data : NULL; - PERL_ARGS_ASSERT_REGCLASS_SWASH; + PERL_ARGS_ASSERT_CORE_REGCLASS_SWASH; + + assert(ANYOF_NONBITMAP(node)); if (data && data->count) { const U32 n = ARG(node); @@ -6493,34 +6521,82 @@ Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool SV * const rv = MUTABLE_SV(data->data[n]); AV * const av = MUTABLE_AV(SvRV(rv)); SV **const ary = AvARRAY(av); - SV **a, **b; + bool invlist_has_user_defined_property; - /* See the end of regcomp.c:S_regclass() for - * documentation of these array elements. */ - - si = *ary; - a = SvROK(ary[1]) ? &ary[1] : NULL; - b = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : NULL; + si = *ary; /* ary[0] = the string to initialize the swash with */ + + /* Elements 3 and 4 are either both present or both absent. [3] is + * any inversion list generated at compile time; [4] indicates if + * that inversion list has any user-defined properties in it. */ + if (av_len(av) >= 3) { + invlist = ary[3]; + invlist_has_user_defined_property = cBOOL(SvUV(ary[4])); + } + else { + invlist = NULL; + invlist_has_user_defined_property = FALSE; + } - if (a) - sw = *a; + /* Element [1] is reserved for the set-up swash. If already there, + * return it; if not, create it and store it there */ + if (SvROK(ary[1])) { + sw = ary[1]; + } else if (si && doinit) { - sw = swash_init("utf8", "", si, 1, 0); + + sw = _core_swash_init("utf8", /* the utf8 package */ + "", /* nameless */ + si, + 1, /* binary */ + 0, /* not from tr/// */ + FALSE, /* is error if can't find + property */ + invlist, + invlist_has_user_defined_property); (void)av_store(av, 1, sw); } - if (b) - alt = *b; + + /* Element [2] is for any multi-char folds. Note that is a + * fundamentally flawed design, because can't backtrack and try + * again. See [perl #89774] */ + if (SvTYPE(ary[2]) == SVt_PVAV) { + alt = ary[2]; + } } } - if (listsvp) - *listsvp = si; + if (listsvp) { + SV* matches_string = newSVpvn("", 0); + SV** invlistsvp; + + /* Use the swash, if any, which has to have incorporated into it all + * possibilities */ + if ( sw + && SvROK(sw) + && SvTYPE(SvRV(sw)) == SVt_PVHV + && (invlistsvp = hv_fetchs(MUTABLE_HV(SvRV(sw)), "INVLIST", FALSE))) + { + invlist = *invlistsvp; + } + else if (si && si != &PL_sv_undef) { + + /* If no swash, use the input nitialization string, if available */ + sv_catsv(matches_string, si); + } + + /* Add the inversion list to whatever we have. This may have come from + * the swash, or from an input parameter */ + if (invlist) { + sv_catsv(matches_string, _invlist_contents(invlist)); + } + *listsvp = matches_string; + } + if (altsvp) *altsvp = alt; return sw; } -#endif /* - reginclass - determine if a character falls into a character class @@ -6611,8 +6687,8 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) || (ANYOF_CLASS_TEST(n, ANYOF_ALPHA) && isALPHA_LC(c)) || (ANYOF_CLASS_TEST(n, ANYOF_NALPHA) && !isALPHA_LC(c)) || - (ANYOF_CLASS_TEST(n, ANYOF_ASCII) && isASCII(c)) || - (ANYOF_CLASS_TEST(n, ANYOF_NASCII) && !isASCII(c)) || + (ANYOF_CLASS_TEST(n, ANYOF_ASCII) && isASCII_LC(c)) || + (ANYOF_CLASS_TEST(n, ANYOF_NASCII) && !isASCII_LC(c)) || (ANYOF_CLASS_TEST(n, ANYOF_CNTRL) && isCNTRL_LC(c)) || (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL) && !isCNTRL_LC(c)) || (ANYOF_CLASS_TEST(n, ANYOF_GRAPH) && isGRAPH_LC(c)) || @@ -6629,8 +6705,8 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c)) || (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC) && isPSXSPC(c)) || (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c)) || - (ANYOF_CLASS_TEST(n, ANYOF_BLANK) && isBLANK(c)) || - (ANYOF_CLASS_TEST(n, ANYOF_NBLANK) && !isBLANK(c)) + (ANYOF_CLASS_TEST(n, ANYOF_BLANK) && isBLANK_LC(c)) || + (ANYOF_CLASS_TEST(n, ANYOF_NBLANK) && !isBLANK_LC(c)) ) /* How's that for a conditional? */ ) { match = TRUE; @@ -6639,16 +6715,27 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, } /* If the bitmap didn't (or couldn't) match, and something outside the - * bitmap could match, try that */ + * bitmap could match, try that. Locale nodes specifiy completely the + * behavior of code points in the bit map (otherwise, a utf8 target would + * cause them to be treated as Unicode and not locale), except in + * the very unlikely event when this node is a synthetic start class, which + * could be a combination of locale and non-locale nodes. So allow locale + * to match for the synthetic start class, which will give a false + * positive that will be resolved when the match is done again as not part + * of the synthetic start class */ if (!match) { if (utf8_target && (flags & ANYOF_UNICODE_ALL) && c >= 256) { match = TRUE; /* Everything above 255 matches */ } - else if ((flags & ANYOF_NONBITMAP_NON_UTF8 - || (utf8_target && flags & ANYOF_UTF8))) + else if (ANYOF_NONBITMAP(n) + && ((flags & ANYOF_NONBITMAP_NON_UTF8) + || (utf8_target + && (c >=256 + || (! (flags & ANYOF_LOCALE)) + || (flags & ANYOF_IS_SYNTHETIC))))) { AV *av; - SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av); + SV * const sw = core_regclass_swash(prog, n, TRUE, 0, (SV**)&av); if (sw) { U8 * utf8_p; @@ -6678,31 +6765,19 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, else if (flags & ANYOF_LOC_NONBITMAP_FOLD) { /* Here, we need to test if the fold of the target string - * matches. In the case of a multi-char fold that is - * caught by regcomp.c, it has stored all such folds into - * 'av'; we linearly check to see if any match the target - * string (folded). We know that the originals were each - * one character, but we don't currently know how many - * characters/bytes each folded to, except we do know that - * there are small limits imposed by Unicode. XXX A - * performance enhancement would be to have regcomp.c store - * the max number of chars/bytes that are in an av entry, - * as, say the 0th element. Even better would be to have a - * hash of the few characters that can start a multi-char - * fold to the max number of chars of those folds. - * - * Further down, if there isn't a - * match in the av, we will check if there is another - * fold-type match. For that, we also need the fold, but - * only the first character. No sense in folding it twice, - * so we do it here, even if there isn't any multi-char - * fold, so we always fold at least the first character. - * If the node is a straight ANYOF node, or there is only - * one character available in the string, or if there isn't - * any av, that's all we have to fold. In the case of a - * multi-char fold, we do have guarantees in Unicode that - * it can only expand up to so many characters and so many - * bytes. We keep track so don't exceed either. + * matches. The non-multi char folds have all been moved to + * the compilation phase, and the multi-char folds have + * been stored by regcomp into 'av'; we linearly check to + * see if any match the target string (folded). We know + * that the originals were each one character, but we don't + * currently know how many characters/bytes each folded to, + * except we do know that there are small limits imposed by + * Unicode. XXX A performance enhancement would be to have + * regcomp.c store the max number of chars/bytes that are + * in an av entry, as, say the 0th element. Even better + * would be to have a hash of the few characters that can + * start a multi-char fold to the max number of chars of + * those folds. * * If there is a match, we will need to advance (if lenp is * specified) the match pointer in the target string. But @@ -6712,28 +6787,34 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, * create a map so that we know how many bytes in the * source to advance given that we have matched a certain * number of bytes in the fold. This map is stored in - * 'map_fold_len_back'. The first character in the fold - * has array element 1 contain the number of bytes in the - * source that folded to it; the 2nd is the cumulative - * number to match it; ... */ - U8 map_fold_len_back[UTF8_MAX_FOLD_CHAR_EXPAND] = { 0 }; + * 'map_fold_len_back'. Let n mean the number of bytes in + * the fold of the first character that we are folding. + * Then map_fold_len_back[n] is set to the number of bytes + * in that first character. Similarly let m be the + * corresponding number for the second character to be + * folded. Then map_fold_len_back[n+m] is set to the + * number of bytes occupied by the first two source + * characters. ... */ + U8 map_fold_len_back[UTF8_MAXBYTES_CASE+1] = { 0 }; U8 folded[UTF8_MAXBYTES_CASE+1]; STRLEN foldlen = 0; /* num bytes in fold of 1st char */ - STRLEN foldlen_for_av; /* num bytes in fold of all chars */ + STRLEN total_foldlen = 0; /* num bytes in fold of all + chars */ if (OP(n) == ANYOF || maxlen == 1 || ! lenp || ! av) { /* Here, only need to fold the first char of the target - * string */ + * string. It the source wasn't utf8, is 1 byte long */ to_utf8_fold(utf8_p, folded, &foldlen); - foldlen_for_av = foldlen; - map_fold_len_back[1] = UTF8SKIP(utf8_p); + total_foldlen = foldlen; + map_fold_len_back[foldlen] = (utf8_target) + ? UTF8SKIP(utf8_p) + : 1; } else { /* Here, need to fold more than the first char. Do so * up to the limits */ - UV which_char = 0; U8* source_ptr = utf8_p; /* The source for the fold is the regex target string */ @@ -6741,8 +6822,10 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, U8* e = utf8_p + maxlen; /* Can't go beyond last available byte in the target string */ - while (which_char < UTF8_MAX_FOLD_CHAR_EXPAND - && source_ptr < e) + U8 i; + for (i = 0; + i < UTF8_MAX_FOLD_CHAR_EXPAND && source_ptr < e; + i++) { /* Fold the next character */ @@ -6760,125 +6843,57 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, break; } - /* Save the first character's folded length, in - * case we have to use it later */ - if (! foldlen) { - foldlen = this_char_foldlen; - } - - /* Here, add the fold of this character */ + /* Add the fold of this character */ Copy(this_char_folded, folded_ptr, this_char_foldlen, U8); - which_char++; - map_fold_len_back[which_char] = - map_fold_len_back[which_char - 1] - + UTF8SKIP(source_ptr); - folded_ptr += this_char_foldlen; source_ptr += UTF8SKIP(source_ptr); + folded_ptr += this_char_foldlen; + total_foldlen = folded_ptr - folded; + + /* Create map from the number of bytes in the fold + * back to the number of bytes in the source. If + * the source isn't utf8, the byte count is just + * the number of characters so far */ + map_fold_len_back[total_foldlen] + = (utf8_target) + ? source_ptr - utf8_p + : i + 1; } *folded_ptr = '\0'; - foldlen_for_av = folded_ptr - folded; } /* Do the linear search to see if the fold is in the list - * of multi-char folds. (Useless to look if won't be able - * to store that it is a multi-char fold in *lenp) */ - if (lenp && av) { + * of multi-char folds. */ + if (av) { I32 i; for (i = 0; i <= av_len(av); i++) { SV* const sv = *av_fetch(av, i, FALSE); STRLEN len; const char * const s = SvPV_const(sv, len); - if (len <= foldlen_for_av && memEQ(s, - (char*)folded, - len)) + + if (len <= total_foldlen + && memEQ(s, (char*)folded, len) + + /* If 0, means matched a partial char. See + * [perl #90536] */ + && map_fold_len_back[len]) { /* Advance the target string ptr to account for * this fold, but have to translate from the * folded length to the corresponding source - * length. The array is indexed by how many - * characters in the match */ - *lenp = map_fold_len_back[ - utf8_length(folded, folded + len)]; + * length. */ + if (lenp) { + *lenp = map_fold_len_back[len]; + } match = TRUE; break; } } } -#if 0 - if (!match) { /* See if the folded version matches */ - SV** listp; - - /* Consider "k" =~ /[K]/i. The line above would have - * just folded the 'k' to itself, and that isn't going - * to match 'K'. So we look through the closure of - * everything that folds to 'k'. That will find the - * 'K'. Initialize the list, if necessary */ - if (! PL_utf8_foldclosures) { - - /* If the folds haven't been read in, call a fold - * function to force that */ - if (! PL_utf8_tofold) { - U8 dummy[UTF8_MAXBYTES+1]; - STRLEN dummy_len; - to_utf8_fold((U8*) "A", dummy, &dummy_len); - } - PL_utf8_foldclosures = - _swash_inversion_hash(PL_utf8_tofold); - } - - /* The data structure is a hash with the keys every - * character that is folded to, like 'k', and the - * values each an array of everything that folds to its - * key. e.g. [ 'k', 'K', KELVIN_SIGN ] */ - if ((listp = hv_fetch(PL_utf8_foldclosures, - (char *) folded, foldlen, FALSE))) - { - AV* list = (AV*) *listp; - IV i; - for (i = 0; i <= av_len(list); i++) { - SV** try_p = av_fetch(list, i, FALSE); - char* try_c; - if (try_p == NULL) { - Perl_croak(aTHX_ "panic: invalid PL_utf8_foldclosures structure"); - } - /* Don't have to worry about embedded nulls - * since NULL isn't folded or foldable */ - try_c = SvPVX(*try_p); - - /* The fold in a few cases of an above Latin1 - * char is in the Latin1 range, and hence may - * be in the bitmap */ - if (UTF8_IS_INVARIANT(*try_c) - && ANYOF_BITMAP_TEST(n, - UNI_TO_NATIVE(*try_c))) - { - match = TRUE; - break; - } - else if - (UTF8_IS_DOWNGRADEABLE_START(*try_c) - && ANYOF_BITMAP_TEST(n, UNI_TO_NATIVE( - TWO_BYTE_UTF8_TO_UNI(try_c[0], - try_c[1])))) - { - /* Since the fold comes from internally - * generated data, we can safely assume it - * is valid utf8 in the test above */ - match = TRUE; - break; - } else if (swash_fetch(sw, (U8*) try_c, TRUE)) { - match = TRUE; - break; - } - } - } - } -#endif } /* If we allocated a string above, free it */ @@ -6893,6 +6908,10 @@ S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, STATIC U8 * S_reghop3(U8 *s, I32 off, const U8* lim) { + /* return the position 'off' UTF-8 characters away from 's', forward if + * 'off' >= 0, backwards if negative. But don't go outside of position + * 'lim', which better be < s if off < 0 */ + dVAR; PERL_ARGS_ASSERT_REGHOP3; @@ -7012,16 +7031,16 @@ S_to_utf8_substr(pTHX_ register regexp *prog) prog->substrs->data[i].utf8_substr = sv; sv_utf8_upgrade(sv); if (SvVALID(prog->substrs->data[i].substr)) { - const U8 flags = BmFLAGS(prog->substrs->data[i].substr); - if (flags & FBMcf_TAIL) { + if (SvTAIL(prog->substrs->data[i].substr)) { /* Trim the trailing \n that fbm_compile added last time. */ SvCUR_set(sv, SvCUR(sv) - 1); /* Whilst this makes the SV technically "invalid" (as its buffer is no longer followed by "\0") when fbm_compile() adds the "\n" back, a "\0" is restored. */ - } - fbm_compile(sv, flags); + fbm_compile(sv, FBMcf_TAIL); + } else + fbm_compile(sv, 0); } if (prog->substrs->data[i].substr == prog->check_substr) prog->check_utf8 = sv; @@ -7043,15 +7062,14 @@ S_to_byte_substr(pTHX_ register regexp *prog) SV* sv = newSVsv(prog->substrs->data[i].utf8_substr); if (sv_utf8_downgrade(sv, TRUE)) { if (SvVALID(prog->substrs->data[i].utf8_substr)) { - const U8 flags - = BmFLAGS(prog->substrs->data[i].utf8_substr); - if (flags & FBMcf_TAIL) { + if (SvTAIL(prog->substrs->data[i].utf8_substr)) { /* Trim the trailing \n that fbm_compile added last time. */ SvCUR_set(sv, SvCUR(sv) - 1); - } - fbm_compile(sv, flags); - } + fbm_compile(sv, FBMcf_TAIL); + } else + fbm_compile(sv, 0); + } } else { SvREFCNT_dec(sv); sv = &PL_sv_undef;