X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a74ff37d56a36f313c3eec2c8f99167b0c7a28d9..a7a22abc1654ce1bee21c7bb8657a3b7c07ae25a:/regexec.c diff --git a/regexec.c b/regexec.c index 432764b..d343c91 100644 --- a/regexec.c +++ b/regexec.c @@ -37,6 +37,9 @@ #include "re_top.h" #endif +#define B_ON_NON_UTF8_LOCALE_IS_WRONG \ + "Use of \\b{} for non-UTF-8 locale is wrong. Assuming a UTF-8 locale" + /* * pregcomp and pregexec -- regsub and regerror are not used in perl * @@ -191,18 +194,6 @@ static const char* const non_utf8_target_but_utf8_required PL_XPosix_ptrs[_CC_WORDCHAR], \ LATIN_CAPITAL_LETTER_SHARP_S_UTF8); -#define LOAD_UTF8_CHARCLASS_GCB() /* Grapheme cluster boundaries */ \ - STMT_START { \ - LOAD_UTF8_CHARCLASS_DEBUG_TEST(PL_utf8_X_regular_begin, \ - "_X_regular_begin", \ - NULL, \ - LATIN_CAPITAL_LETTER_SHARP_S_UTF8); \ - LOAD_UTF8_CHARCLASS_DEBUG_TEST(PL_utf8_X_extend, \ - "_X_extend", \ - NULL, \ - COMBINING_GRAVE_ACCENT_UTF8); \ - } STMT_END - #define PLACEHOLDER /* Something for the preprocessor to grab onto */ /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */ @@ -231,15 +222,15 @@ static const char* const non_utf8_target_but_utf8_required #if 0 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so - we don't need this definition. */ + we don't need this definition. XXX These are now out-of-sync*/ #define IS_TEXT(rn) ( OP(rn)==EXACT || OP(rn)==REF || OP(rn)==NREF ) #define IS_TEXTF(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFU_SS || OP(rn)==EXACTFA || OP(rn)==EXACTFA_NO_TRIE || 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 || OP(rn)==EXACTFU_SS || OP(rn) == EXACTFA || OP(rn) == EXACTFA_NO_TRIE) +#define IS_TEXT(rn) ( OP(rn)==EXACT || OP(rn)==EXACTL ) +#define IS_TEXTFU(rn) ( OP(rn)==EXACTFU || OP(rn)==EXACTFLU8 || OP(rn)==EXACTFU_SS || OP(rn) == EXACTFA || OP(rn) == EXACTFA_NO_TRIE) #define IS_TEXTF(rn) ( OP(rn)==EXACTF ) #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL ) @@ -262,16 +253,6 @@ static const char* const non_utf8_target_but_utf8_required } \ } STMT_END -/* These constants are for finding GCB=LV and GCB=LVT in the CLUMP regnode. - * These are for the pre-composed Hangul syllables, which are all in a - * contiguous block and arranged there in such a way so as to facilitate - * alorithmic determination of their characteristics. As such, they don't need - * a swash, but can be determined by simple arithmetic. Almost all are - * GCB=LVT, but every 28th one is a GCB=LV */ -#define SBASE 0xAC00 /* Start of block */ -#define SCount 11172 /* Length of block */ -#define TCount 28 - #define SLAB_FIRST(s) (&(s)->states[0]) #define SLAB_LAST(s) (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1]) @@ -475,7 +456,6 @@ S_isFOO_lc(pTHX_ const U8 classnum, const U8 character) case _CC_ENUM_GRAPH: return isGRAPH_LC(character); case _CC_ENUM_LOWER: return isLOWER_LC(character); case _CC_ENUM_PRINT: return isPRINT_LC(character); - case _CC_ENUM_PSXSPC: return isPSXSPC_LC(character); case _CC_ENUM_PUNCT: return isPUNCT_LC(character); case _CC_ENUM_SPACE: return isSPACE_LC(character); case _CC_ENUM_UPPER: return isUPPER_LC(character); @@ -485,7 +465,7 @@ S_isFOO_lc(pTHX_ const U8 classnum, const U8 character) Perl_croak(aTHX_ "panic: isFOO_lc() has an unexpected character class '%d'", classnum); } - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ return FALSE; } @@ -498,7 +478,7 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character) * '_char_class_number'. * * This just calls isFOO_lc on the code point for the character if it is in - * the range 0-255. Outside that range, all characters avoid Unicode + * the range 0-255. Outside that range, all characters use Unicode * rules, ignoring any locale. So use the Unicode function if this class * requires a swash, and use the Unicode macro otherwise. */ @@ -512,6 +492,8 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character) TWO_BYTE_UTF8_TO_NATIVE(*character, *(character + 1))); } + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(character, character + UTF8SKIP(character)); + if (classnum < _FIRST_NON_SWASH_CC) { /* Initialize the swash unless done already */ @@ -530,22 +512,14 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character) } switch ((_char_class_number) classnum) { - case _CC_ENUM_SPACE: - case _CC_ENUM_PSXSPC: return is_XPERLSPACE_high(character); - + case _CC_ENUM_SPACE: return is_XPERLSPACE_high(character); case _CC_ENUM_BLANK: return is_HORIZWS_high(character); case _CC_ENUM_XDIGIT: return is_XDIGIT_high(character); case _CC_ENUM_VERTSPACE: return is_VERTWS_high(character); - default: return 0; /* Things like CNTRL are always - below 256 */ + default: break; } - /* NOTREACHED */ - /* Some compilers/linters detect that this spot cannot be reached - * (because all code paths above already did return), while some - * others throw a fit unless we have a return at the end. */ - assert(0); - return FALSE; + return FALSE; /* Things like CNTRL are always below 256 */ } /* @@ -709,6 +683,7 @@ Perl_re_intuit_start(pTHX_ goto fail; } + RX_MATCH_UTF8_set(rx,utf8_target); reginfo->is_utf8_target = cBOOL(utf8_target); reginfo->info_aux = NULL; reginfo->strbeg = strbeg; @@ -757,7 +732,7 @@ Perl_re_intuit_start(pTHX_ /* ml_anch: check after \n? * - * A note about IMPLICIT: on an un-anchored pattern beginning + * A note about PREGf_IMPLICIT: on an un-anchored pattern beginning * with /.*.../, these flags will have been added by the * compiler: * /.*abc/, /.*abc/m: PREGf_IMPLICIT | PREGf_ANCH_MBOL @@ -778,7 +753,7 @@ Perl_re_intuit_start(pTHX_ * be too fiddly (e.g. REXEC_IGNOREPOS). */ if ( strpos != strbeg - && (prog->intflags & (PREGf_ANCH_BOL|PREGf_ANCH_SBOL))) + && (prog->intflags & PREGf_ANCH_SBOL)) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " Not at start...\n")); @@ -902,7 +877,7 @@ Perl_re_intuit_start(pTHX_ /* If the regex is absolutely anchored to either the start of the - * string (BOL,SBOL) or to pos() (ANCH_GPOS), then + * string (SBOL) or to pos() (ANCH_GPOS), then * check_offset_max represents an upper bound on the string where * the substr could start. For the ANCH_GPOS case, we assume that * the caller of intuit will have already set strpos to @@ -1438,23 +1413,39 @@ Perl_re_intuit_start(pTHX_ #define DECL_TRIE_TYPE(scan) \ - const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold, \ - trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold } \ - trie_type = ((scan->flags == EXACT) \ - ? (utf8_target ? trie_utf8 : trie_plain) \ - : (scan->flags == EXACTFA) \ - ? (utf8_target ? trie_utf8_exactfa_fold : trie_latin_utf8_exactfa_fold) \ - : (utf8_target ? trie_utf8_fold : trie_latin_utf8_fold)) + const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold, \ + trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold, \ + trie_utf8l, trie_flu8 } \ + trie_type = ((scan->flags == EXACT) \ + ? (utf8_target ? trie_utf8 : trie_plain) \ + : (scan->flags == EXACTL) \ + ? (utf8_target ? trie_utf8l : trie_plain) \ + : (scan->flags == EXACTFA) \ + ? (utf8_target \ + ? trie_utf8_exactfa_fold \ + : trie_latin_utf8_exactfa_fold) \ + : (scan->flags == EXACTFLU8 \ + ? trie_flu8 \ + : (utf8_target \ + ? trie_utf8_fold \ + : trie_latin_utf8_fold))) #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \ STMT_START { \ STRLEN skiplen; \ U8 flags = FOLD_FLAGS_FULL; \ switch (trie_type) { \ + case trie_flu8: \ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \ + if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \ + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc)); \ + } \ + goto do_trie_utf8_fold; \ case trie_utf8_exactfa_fold: \ flags |= FOLD_FLAGS_NOMIX_ASCII; \ - /* FALLTHROUGH */ \ + /* FALLTHROUGH */ \ case trie_utf8_fold: \ + do_trie_utf8_fold: \ if ( foldlen>0 ) { \ uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \ foldlen -= len; \ @@ -1470,7 +1461,7 @@ STMT_START { break; \ case trie_latin_utf8_exactfa_fold: \ flags |= FOLD_FLAGS_NOMIX_ASCII; \ - /* FALLTHROUGH */ \ + /* FALLTHROUGH */ \ case trie_latin_utf8_fold: \ if ( foldlen>0 ) { \ uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \ @@ -1485,6 +1476,12 @@ STMT_START { uscan = foldbuf + skiplen; \ } \ break; \ + case trie_utf8l: \ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \ + if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \ + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc)); \ + } \ + /* FALLTHROUGH */ \ case trie_utf8: \ uvc = utf8n_to_uvchr( (const U8*) uc, UTF8_MAXLEN, &len, uniflags ); \ break; \ @@ -1694,7 +1691,7 @@ REXEC_FBC_SCAN( /* Loops while (s < strend) */ \ FBC_UTF8(TEST_UV, TEST_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), \ TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER) -#define FBC_BOUND_A(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \ +#define FBC_BOUND_A(TEST_NON_UTF8) \ FBC_BOUND_COMMON( \ FBC_UTF8_A(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), \ TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER) @@ -1704,11 +1701,63 @@ REXEC_FBC_SCAN( /* Loops while (s < strend) */ \ FBC_UTF8(TEST_UV, TEST_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), \ TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT) -#define FBC_NBOUND_A(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \ +#define FBC_NBOUND_A(TEST_NON_UTF8) \ FBC_BOUND_COMMON( \ FBC_UTF8_A(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), \ TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT) +/* Takes a pointer to an inversion list, a pointer to its corresponding + * inversion map, and a code point, and returns the code point's value + * according to the two arrays. It assumes that all code points have a value. + * This is used as the base macro for macros for particular properties */ +#define _generic_GET_BREAK_VAL_CP(invlist, invmap, cp) \ + invmap[_invlist_search(invlist, cp)] + +/* Same as above, but takes begin, end ptrs to a UTF-8 encoded string instead + * of a code point, returning the value for the first code point in the string. + * And it takes the particular macro name that finds the desired value given a + * code point. Merely convert the UTF-8 to code point and call the cp macro */ +#define _generic_GET_BREAK_VAL_UTF8(cp_macro, pos, strend) \ + (__ASSERT_(pos < strend) \ + /* Note assumes is valid UTF-8 */ \ + (cp_macro(utf8_to_uvchr_buf((pos), (strend), NULL)))) + +/* Returns the GCB value for the input code point */ +#define getGCB_VAL_CP(cp) \ + _generic_GET_BREAK_VAL_CP( \ + PL_GCB_invlist, \ + Grapheme_Cluster_Break_invmap, \ + (cp)) + +/* Returns the GCB value for the first code point in the UTF-8 encoded string + * bounded by pos and strend */ +#define getGCB_VAL_UTF8(pos, strend) \ + _generic_GET_BREAK_VAL_UTF8(getGCB_VAL_CP, pos, strend) + + +/* Returns the SB value for the input code point */ +#define getSB_VAL_CP(cp) \ + _generic_GET_BREAK_VAL_CP( \ + PL_SB_invlist, \ + Sentence_Break_invmap, \ + (cp)) + +/* Returns the SB value for the first code point in the UTF-8 encoded string + * bounded by pos and strend */ +#define getSB_VAL_UTF8(pos, strend) \ + _generic_GET_BREAK_VAL_UTF8(getSB_VAL_CP, pos, strend) + +/* Returns the WB value for the input code point */ +#define getWB_VAL_CP(cp) \ + _generic_GET_BREAK_VAL_CP( \ + PL_WB_invlist, \ + Word_Break_invmap, \ + (cp)) + +/* Returns the WB value for the first code point in the UTF-8 encoded string + * bounded by pos and strend */ +#define getWB_VAL_UTF8(pos, strend) \ + _generic_GET_BREAK_VAL_UTF8(getWB_VAL_CP, pos, strend) /* We know what class REx starts with. Try to find this position... */ /* if reginfo->intuit, its a dryrun */ @@ -1744,6 +1793,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, /* We know what class it must start with. */ switch (OP(c)) { + case ANYOFL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + /* FALLTHROUGH */ case ANYOF: if (utf8_target) { REXEC_FBC_UTF8_CLASS_SCAN( @@ -1785,6 +1837,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, goto do_exactf_non_utf8; case EXACTFL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; if (is_utf8_pat || utf8_target || IN_UTF8_CTYPE_LOCALE) { utf8_fold_flags = FOLDEQ_LOCALE; goto do_exactf_utf8; @@ -1799,6 +1852,15 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, } goto do_exactf_utf8; + case EXACTFLU8: + if (! utf8_target) { /* All code points in this node require + UTF-8 to express. */ + break; + } + utf8_fold_flags = FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED + | FOLDEQ_S2_FOLDS_SANE; + goto do_exactf_utf8; + case EXACTFU: if (is_utf8_pat || utf8_target) { utf8_fold_flags = is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0; @@ -1813,7 +1875,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, /* FALLTHROUGH */ - do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there + 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 */ @@ -1847,8 +1909,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, } break; - do_exactf_utf8: - { + do_exactf_utf8: + { unsigned expansion; /* If one of the operands is in utf8, we can't use the simpler folding @@ -1904,29 +1966,260 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, } case BOUNDL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + if (FLAGS(c) != TRADITIONAL_BOUND) { + Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), + B_ON_NON_UTF8_LOCALE_IS_WRONG); + goto do_boundu; + } + FBC_BOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8); break; + case NBOUNDL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + if (FLAGS(c) != TRADITIONAL_BOUND) { + Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), + B_ON_NON_UTF8_LOCALE_IS_WRONG); + goto do_nboundu; + } + FBC_NBOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8); break; - case BOUND: + + case BOUND: /* regcomp.c makes sure that this only has the traditional \b + meaning */ + assert(FLAGS(c) == TRADITIONAL_BOUND); + FBC_BOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8); break; - case BOUNDA: - FBC_BOUND_A(isWORDCHAR_A, isWORDCHAR_A, isWORDCHAR_A); + + case BOUNDA: /* regcomp.c makes sure that this only has the traditional \b + meaning */ + assert(FLAGS(c) == TRADITIONAL_BOUND); + + FBC_BOUND_A(isWORDCHAR_A); break; - case NBOUND: + + case NBOUND: /* regcomp.c makes sure that this only has the traditional \b + meaning */ + assert(FLAGS(c) == TRADITIONAL_BOUND); + FBC_NBOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8); break; - case NBOUNDA: - FBC_NBOUND_A(isWORDCHAR_A, isWORDCHAR_A, isWORDCHAR_A); - break; - case BOUNDU: - FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); + + case NBOUNDA: /* regcomp.c makes sure that this only has the traditional \b + meaning */ + assert(FLAGS(c) == TRADITIONAL_BOUND); + + FBC_NBOUND_A(isWORDCHAR_A); break; + case NBOUNDU: - FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); + if ((bound_type) FLAGS(c) == TRADITIONAL_BOUND) { + FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); + break; + } + + do_nboundu: + + to_complement = 1; + /* FALLTHROUGH */ + + case BOUNDU: + do_boundu: + switch((bound_type) FLAGS(c)) { + case TRADITIONAL_BOUND: + FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); + break; + case GCB_BOUND: + if (s == reginfo->strbeg) { /* GCB always matches at begin and + end */ + if (to_complement ^ cBOOL(reginfo->intuit + || regtry(reginfo, &s))) + { + goto got_it; + } + s += (utf8_target) ? UTF8SKIP(s) : 1; + } + + if (utf8_target) { + PL_GCB_enum before = getGCB_VAL_UTF8( + reghop3((U8*)s, -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend); + while (s < strend) { + PL_GCB_enum after = getGCB_VAL_UTF8((U8*) s, + (U8*) reginfo->strend); + if (to_complement ^ isGCB(before, after)) { + if (reginfo->intuit || regtry(reginfo, &s)) { + goto got_it; + } + before = after; + } + s += UTF8SKIP(s); + } + } + else { /* Not utf8. Everything is a GCB except between CR and + LF */ + while (s < strend) { + if (to_complement ^ (UCHARAT(s - 1) != '\r' + || UCHARAT(s) != '\n')) + { + if (reginfo->intuit || regtry(reginfo, &s)) { + goto got_it; + } + s++; + } + } + } + + if (to_complement ^ cBOOL(reginfo->intuit || regtry(reginfo, &s))) { + goto got_it; + } + break; + + case SB_BOUND: + if (s == reginfo->strbeg) { /* SB always matches at beginning */ + if (to_complement + ^ cBOOL(reginfo->intuit || regtry(reginfo, &s))) + { + goto got_it; + } + + /* Didn't match. Go try at the next position */ + s += (utf8_target) ? UTF8SKIP(s) : 1; + } + + if (utf8_target) { + PL_SB_enum before = getSB_VAL_UTF8(reghop3((U8*)s, + -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend); + while (s < strend) { + PL_SB_enum after = getSB_VAL_UTF8((U8*) s, + (U8*) reginfo->strend); + if (to_complement ^ isSB(before, + after, + (U8*) reginfo->strbeg, + (U8*) s, + (U8*) reginfo->strend, + utf8_target)) + { + if (reginfo->intuit || regtry(reginfo, &s)) { + goto got_it; + } + before = after; + } + s += UTF8SKIP(s); + } + } + else { /* Not utf8. */ + PL_SB_enum before = getSB_VAL_CP((U8) *(s -1)); + while (s < strend) { + PL_SB_enum after = getSB_VAL_CP((U8) *s); + if (to_complement ^ isSB(before, + after, + (U8*) reginfo->strbeg, + (U8*) s, + (U8*) reginfo->strend, + utf8_target)) + { + if (reginfo->intuit || regtry(reginfo, &s)) { + goto got_it; + } + before = after; + } + s++; + } + } + + /* Here are at the final position in the target string. The SB + * value is always true here, so matches, depending on other + * constraints */ + if (to_complement ^ cBOOL(reginfo->intuit + || regtry(reginfo, &s))) + { + goto got_it; + } + + break; + + case WB_BOUND: + if (s == reginfo->strbeg) { + if (to_complement ^ cBOOL(reginfo->intuit + || regtry(reginfo, &s))) + { + goto got_it; + } + s += (utf8_target) ? UTF8SKIP(s) : 1; + } + + if (utf8_target) { + /* We are at a boundary between char_sub_0 and char_sub_1. + * We also keep track of the value for char_sub_-1 as we + * loop through the line. Context may be needed to make a + * determination, and if so, this can save having to + * recalculate it */ + PL_WB_enum previous = PL_WB_UNKNOWN; + PL_WB_enum before = getWB_VAL_UTF8( + reghop3((U8*)s, + -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend); + while (s < strend) { + PL_WB_enum after = getWB_VAL_UTF8((U8*) s, + (U8*) reginfo->strend); + if (to_complement ^ isWB(previous, + before, + after, + (U8*) reginfo->strbeg, + (U8*) s, + (U8*) reginfo->strend, + utf8_target)) + { + if (reginfo->intuit || regtry(reginfo, &s)) { + goto got_it; + } + previous = before; + before = after; + } + s += UTF8SKIP(s); + } + } + else { /* Not utf8. */ + PL_WB_enum previous = PL_WB_UNKNOWN; + PL_WB_enum before = getWB_VAL_CP((U8) *(s -1)); + while (s < strend) { + PL_WB_enum after = getWB_VAL_CP((U8) *s); + if (to_complement ^ isWB(previous, + before, + after, + (U8*) reginfo->strbeg, + (U8*) s, + (U8*) reginfo->strend, + utf8_target)) + { + if (reginfo->intuit || regtry(reginfo, &s)) { + goto got_it; + } + previous = before; + before = after; + } + s++; + } + } + + if (to_complement ^ cBOOL(reginfo->intuit + || regtry(reginfo, &s))) + { + goto got_it; + } + + break; + } break; + case LNBREAK: REXEC_FBC_CSCAN(is_LNBREAK_utf8_safe(s, strend), is_LNBREAK_latin1_safe(s, strend) @@ -1941,6 +2234,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, /* FALLTHROUGH */ case POSIXL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; REXEC_FBC_CSCAN(to_complement ^ cBOOL(isFOO_utf8_lc(FLAGS(c), (U8 *) s)), to_complement ^ cBOOL(isFOO_lc(FLAGS(c), *s))); break; @@ -1986,7 +2280,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, } else { - posix_utf8: + posix_utf8: classnum = (_char_class_number) FLAGS(c); if (classnum < _FIRST_NON_SWASH_CC) { while (s < strend) { @@ -2021,11 +2315,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, } else switch (classnum) { /* These classes are implemented as macros */ - case _CC_ENUM_SPACE: /* XXX would require separate code if we - revert the change of \v matching this */ - /* FALLTHROUGH */ - - case _CC_ENUM_PSXSPC: + case _CC_ENUM_SPACE: REXEC_FBC_UTF8_CLASS_SCAN( to_complement ^ cBOOL(isSPACE_utf8(s))); break; @@ -2052,7 +2342,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, default: Perl_croak(aTHX_ "panic: find_byclass() node %d='%s' has an unexpected character class '%d'", OP(c), PL_reg_name[OP(c)], classnum); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } } break; @@ -2623,6 +2913,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, } RX_MATCH_TAINTED_off(rx); + RX_MATCH_UTF8_set(rx, utf8_target); reginfo->prog = rx; /* Yes, sorry that this is confusing. */ reginfo->intuit = 0; @@ -2643,7 +2934,6 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, magic belonging to this SV. Not newSVsv, either, as it does not COW. */ - assert(!IS_PADGV(sv)); reginfo->sv = newSV(0); SvSetSV_nosteal(reginfo->sv, sv); SAVEFREESV(reginfo->sv); @@ -2720,86 +3010,52 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, )); } - /* Simplest case: anchored match need be tried only once. */ - /* [unless only anchor is BOL and multiline is set] */ + /* Simplest case: anchored match need be tried only once, or with + * MBOL, only at the beginning of each line. + * + * Note that /.*.../ sets PREGf_IMPLICIT|MBOL, while /.*.../s sets + * PREGf_IMPLICIT|SBOL. The idea is that with /.*.../s, if it doesn't + * match at the start of the string then it won't match anywhere else + * either; while with /.*.../, if it doesn't match at the beginning, + * the earliest it could match is at the start of the next line */ + if (prog->intflags & (PREGf_ANCH & ~PREGf_ANCH_GPOS)) { - if (s == startpos && regtry(reginfo, &s)) + char *end; + + if (regtry(reginfo, &s)) goto got_it; - else if (multiline || (prog->intflags & (PREGf_IMPLICIT | PREGf_ANCH_MBOL))) /* XXXX SBOL? */ - { - char *end; - - if (minlen) - dontbother = minlen - 1; - end = HOP3c(strend, -dontbother, strbeg) - 1; - /* for multiline we only have to try after newlines */ - if (prog->check_substr || prog->check_utf8) { - /* because of the goto we can not easily reuse the macros for bifurcating the - unicode/non-unicode match modes here like we do elsewhere - demerphq */ - if (utf8_target) { - if (s == startpos) - goto after_try_utf8; - while (1) { - if (regtry(reginfo, &s)) { - goto got_it; - } - after_try_utf8: - if (s > end) { - goto phooey; - } - if (prog->extflags & RXf_USE_INTUIT) { - s = re_intuit_start(rx, sv, strbeg, - s + UTF8SKIP(s), strend, flags, NULL); - if (!s) { - goto phooey; - } - } - else { - s += UTF8SKIP(s); - } - } - } /* end search for check string in unicode */ - else { - if (s == startpos) { - goto after_try_latin; - } - while (1) { - if (regtry(reginfo, &s)) { - goto got_it; - } - after_try_latin: - if (s > end) { - goto phooey; - } - if (prog->extflags & RXf_USE_INTUIT) { - s = re_intuit_start(rx, sv, strbeg, - s + 1, strend, flags, NULL); - if (!s) { - goto phooey; - } - } - else { - s++; - } - } - } /* end search for check string in latin*/ - } /* end search for check string */ - else { /* search for newline */ - if (s > startpos) { - /*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) { /* note it could be possible to match at the end of the string */ - if (*s++ == '\n') { /* don't need PL_utf8skip here */ - if (regtry(reginfo, &s)) - goto got_it; - } - } - } /* end search for newline */ - } /* end anchored/multiline check string search */ - goto phooey; - } else if (prog->intflags & PREGf_ANCH_GPOS) + + if (!(prog->intflags & PREGf_ANCH_MBOL)) + goto phooey; + + /* didn't match at start, try at other newline positions */ + + if (minlen) + dontbother = minlen - 1; + end = HOP3c(strend, -dontbother, strbeg) - 1; + + /* skip to next newline */ + + while (s <= end) { /* note it could be possible to match at the end of the string */ + /* NB: newlines are the same in unicode as they are in latin */ + if (*s++ != '\n') + continue; + if (prog->check_substr || prog->check_utf8) { + /* note that with PREGf_IMPLICIT, intuit can only fail + * or return the start position, so it's of limited utility. + * Nevertheless, I made the decision that the potential for + * quick fail was still worth it - DAPM */ + s = re_intuit_start(rx, sv, strbeg, s, strend, flags, NULL); + if (!s) + goto phooey; + } + if (regtry(reginfo, &s)) + goto got_it; + } + goto phooey; + } /* end anchored search */ + + if (prog->intflags & PREGf_ANCH_GPOS) { /* PREGf_ANCH_GPOS should never be true if PREGf_GPOS_SEEN is not true */ assert(prog->intflags & PREGf_GPOS_SEEN); @@ -2975,7 +3231,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, } DEBUG_EXECUTE_r({ SV * const prop = sv_newmortal(); - regprop(prog, prop, c, reginfo); + regprop(prog, prop, c, reginfo, NULL); { RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1), s,strend-s,60); @@ -3081,7 +3337,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, * and replaced it with this one. Yves */ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, - "String does not contain required substring, cannot match.\n" + "%sString does not contain required substring, cannot match.%s\n", + PL_colors[4], PL_colors[5] )); goto phooey; } @@ -3111,7 +3368,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, /* Failure. */ goto phooey; -got_it: + got_it: /* s/// doesn't like it if $& is earlier than where we asked it to * start searching (which can happen on something like /.\G/) */ if ( (flags & REXEC_FAIL_ON_UNDERFLOW) @@ -3143,8 +3400,6 @@ got_it: if (RXp_PAREN_NAMES(prog)) (void)hv_iterinit(RXp_PAREN_NAMES(prog)); - RX_MATCH_UTF8_set(rx, utf8_target); - /* make sure $`, $&, $', and $digit will work later */ if ( !(flags & REXEC_NOT_FIRST) ) S_reg_set_capture_string(aTHX_ rx, @@ -3153,7 +3408,7 @@ got_it: return 1; -phooey: + phooey: DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n", PL_colors[4], PL_colors[5])); @@ -3654,7 +3909,7 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, U8 *pat = (U8*)STRING(text_node); U8 folded[UTF8_MAX_FOLD_CHAR_EXPAND * UTF8_MAXBYTES_CASE + 1] = { '\0' }; - if (OP(text_node) == EXACT) { + if (OP(text_node) == EXACT || OP(text_node) == EXACTL) { /* In an exact node, only one thing can be matched, that first * character. If both the pat and the target are UTF-8, we can just @@ -3850,7 +4105,7 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, default: Perl_croak(aTHX_ "panic: Unexpected op %u", OP(text_node)); - assert(0); /* NOTREACHED */ + NOT_REACHED; /* NOTREACHED */ } } } @@ -3892,112 +4147,728 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, return TRUE; } -/* returns -1 on failure, $+[0] on success */ -STATIC SSize_t -S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) +/* This creates a single number by combining two, with 'before' being like the + * 10's digit, but this isn't necessarily base 10; it is base however many + * elements of the enum there are */ +#define GCBcase(before, after) ((PL_GCB_ENUM_COUNT * before) + after) + +STATIC bool +S_isGCB(const PL_GCB_enum before, const PL_GCB_enum after) { -#if PERL_VERSION < 9 && !defined(PERL_CORE) - dMY_CXT; -#endif - dVAR; - const bool utf8_target = reginfo->is_utf8_target; - const U32 uniflags = UTF8_ALLOW_DEFAULT; - REGEXP *rex_sv = reginfo->prog; - regexp *rex = ReANY(rex_sv); - RXi_GET_DECL(rex,rexi); - /* the current state. This is a cached copy of PL_regmatch_state */ - regmatch_state *st; - /* cache heavy used fields of st in registers */ - regnode *scan; - regnode *next; - U32 n = 0; /* general value; init to avoid compiler warning */ - SSize_t ln = 0; /* len or last; init to avoid compiler warning */ - char *locinput = startpos; - char *pushinput; /* where to continue after a PUSH */ - I32 nextchr; /* is always set to UCHARAT(locinput) */ + /* returns a boolean indicating if there is a Grapheme Cluster Boundary + * between the inputs. See http://www.unicode.org/reports/tr29/ */ + + switch (GCBcase(before, after)) { + + /* Break at the start and end of text. + GB1. sot ÷ + GB2. ÷ eot + + Break before and after controls except between CR and LF + GB4. ( Control | CR | LF ) ÷ + GB5. ÷ ( Control | CR | LF ) + + Otherwise, break everywhere. + GB10. Any ÷ Any */ + default: + return TRUE; + + /* Do not break between a CR and LF. + GB3. CR × LF */ + case GCBcase(PL_GCB_CR, PL_GCB_LF): + return FALSE; + + /* Do not break Hangul syllable sequences. + GB6. L × ( L | V | LV | LVT ) */ + case GCBcase(PL_GCB_L, PL_GCB_L): + case GCBcase(PL_GCB_L, PL_GCB_V): + case GCBcase(PL_GCB_L, PL_GCB_LV): + case GCBcase(PL_GCB_L, PL_GCB_LVT): + return FALSE; + + /* GB7. ( LV | V ) × ( V | T ) */ + case GCBcase(PL_GCB_LV, PL_GCB_V): + case GCBcase(PL_GCB_LV, PL_GCB_T): + case GCBcase(PL_GCB_V, PL_GCB_V): + case GCBcase(PL_GCB_V, PL_GCB_T): + return FALSE; + + /* GB8. ( LVT | T) × T */ + case GCBcase(PL_GCB_LVT, PL_GCB_T): + case GCBcase(PL_GCB_T, PL_GCB_T): + return FALSE; + + /* Do not break between regional indicator symbols. + GB8a. Regional_Indicator × Regional_Indicator */ + case GCBcase(PL_GCB_Regional_Indicator, PL_GCB_Regional_Indicator): + return FALSE; + + /* Do not break before extending characters. + GB9. × Extend */ + case GCBcase(PL_GCB_Other, PL_GCB_Extend): + case GCBcase(PL_GCB_Extend, PL_GCB_Extend): + case GCBcase(PL_GCB_L, PL_GCB_Extend): + case GCBcase(PL_GCB_LV, PL_GCB_Extend): + case GCBcase(PL_GCB_LVT, PL_GCB_Extend): + case GCBcase(PL_GCB_Prepend, PL_GCB_Extend): + case GCBcase(PL_GCB_Regional_Indicator, PL_GCB_Extend): + case GCBcase(PL_GCB_SpacingMark, PL_GCB_Extend): + case GCBcase(PL_GCB_T, PL_GCB_Extend): + case GCBcase(PL_GCB_V, PL_GCB_Extend): + return FALSE; + + /* Do not break before SpacingMarks, or after Prepend characters. + GB9a. × SpacingMark */ + case GCBcase(PL_GCB_Other, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_Extend, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_L, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_LV, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_LVT, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_Prepend, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_Regional_Indicator, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_SpacingMark, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_T, PL_GCB_SpacingMark): + case GCBcase(PL_GCB_V, PL_GCB_SpacingMark): + return FALSE; + + /* GB9b. Prepend × */ + case GCBcase(PL_GCB_Prepend, PL_GCB_Other): + case GCBcase(PL_GCB_Prepend, PL_GCB_L): + case GCBcase(PL_GCB_Prepend, PL_GCB_LV): + case GCBcase(PL_GCB_Prepend, PL_GCB_LVT): + case GCBcase(PL_GCB_Prepend, PL_GCB_Prepend): + case GCBcase(PL_GCB_Prepend, PL_GCB_Regional_Indicator): + case GCBcase(PL_GCB_Prepend, PL_GCB_T): + case GCBcase(PL_GCB_Prepend, PL_GCB_V): + return FALSE; + } - bool result = 0; /* return value of S_regmatch */ - int depth = 0; /* depth of backtrack stack */ - U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */ - const U32 max_nochange_depth = - (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ? - 3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH; - regmatch_state *yes_state = NULL; /* state to pop to on success of - subpattern */ - /* mark_state piggy backs on the yes_state logic so that when we unwind - the stack on success we can update the mark_state as we go */ - regmatch_state *mark_state = NULL; /* last mark state we have seen */ - regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */ - struct regmatch_state *cur_curlyx = NULL; /* most recent curlyx */ - U32 state_num; - bool no_final = 0; /* prevent failure from backtracking? */ - bool do_cutgroup = 0; /* no_final only until next branch/trie entry */ - char *startpoint = locinput; - SV *popmark = NULL; /* are we looking for a mark? */ - SV *sv_commit = NULL; /* last mark name seen in failure */ - SV *sv_yes_mark = NULL; /* last mark name we have seen - during a successful match */ - U32 lastopen = 0; /* last open we saw */ - bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0; - SV* const oreplsv = GvSVn(PL_replgv); - /* these three flags are set by various ops to signal information to - * the very next op. They have a useful lifetime of exactly one loop - * iteration, and are not preserved or restored by state pushes/pops - */ - bool sw = 0; /* the condition value in (?(cond)a|b) */ - bool minmod = 0; /* the next "{n,m}" is a "{n,m}?" */ - int logical = 0; /* the following EVAL is: - 0: (?{...}) - 1: (?(?{...})X|Y) - 2: (??{...}) - or the following IFMATCH/UNLESSM is: - false: plain (?=foo) - true: used as a condition: (?(?=foo)) - */ - PAD* last_pad = NULL; - dMULTICALL; - I32 gimme = G_SCALAR; - CV *caller_cv = NULL; /* who called us */ - CV *last_pushed_cv = NULL; /* most recently called (?{}) CV */ - CHECKPOINT runops_cp; /* savestack position before executing EVAL */ - U32 maxopenparen = 0; /* max '(' index seen so far */ - int to_complement; /* Invert the result? */ - _char_class_number classnum; - bool is_utf8_pat = reginfo->is_utf8_pat; + NOT_REACHED; /* NOTREACHED */ +} -#ifdef DEBUGGING - GET_RE_DEBUG_FLAGS_DECL; -#endif +#define SBcase(before, after) ((SB_ENUM_COUNT * before) + after) - /* protect against undef(*^R) */ - SAVEFREESV(SvREFCNT_inc_simple_NN(oreplsv)); +STATIC bool +S_isSB(pTHX_ PL_SB_enum before, + PL_SB_enum after, + const U8 * const strbeg, + const U8 * const curpos, + const U8 * const strend, + const bool utf8_target) +{ + /* returns a boolean indicating if there is a Sentence Boundary Break + * between the inputs. See http://www.unicode.org/reports/tr29/ */ - /* shut up 'may be used uninitialized' compiler warnings for dMULTICALL */ - multicall_oldcatch = 0; - multicall_cv = NULL; - cx = NULL; - PERL_UNUSED_VAR(multicall_cop); - PERL_UNUSED_VAR(newsp); + U8 * lpos = (U8 *) curpos; + U8 * temp_pos; + PL_SB_enum backup; + PERL_ARGS_ASSERT_ISSB; - PERL_ARGS_ASSERT_REGMATCH; + /* Break at the start and end of text. + SB1. sot ÷ + SB2. ÷ eot */ + if (before == PL_SB_EDGE || after == PL_SB_EDGE) { + return TRUE; + } - DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({ - PerlIO_printf(Perl_debug_log,"regmatch start\n"); - })); + /* SB 3: Do not break within CRLF. */ + if (before == PL_SB_CR && after == PL_SB_LF) { + return FALSE; + } - st = PL_regmatch_state; + /* Break after paragraph separators. (though why CR and LF are considered + * so is beyond me (khw) + SB4. Sep | CR | LF ÷ */ + if (before == PL_SB_Sep || before == PL_SB_CR || before == PL_SB_LF) { + return TRUE; + } - /* Note that nextchr is a byte even in UTF */ - SET_nextchr; - scan = prog; - while (scan != NULL) { + /* Ignore Format and Extend characters, except after sot, Sep, CR, or LF. + * (See Section 6.2, Replacing Ignore Rules.) + SB5. X (Extend | Format)* → X */ + if (after == PL_SB_Extend || after == PL_SB_Format) { + return FALSE; + } + + if (before == PL_SB_Extend || before == PL_SB_Format) { + before = backup_one_SB(strbeg, &lpos, utf8_target); + } + + /* Do not break after ambiguous terminators like period, if they are + * immediately followed by a number or lowercase letter, if they are + * between uppercase letters, if the first following letter (optionally + * after certain punctuation) is lowercase, or if they are followed by + * "continuation" punctuation such as comma, colon, or semicolon. For + * example, a period may be an abbreviation or numeric period, and thus may + * not mark the end of a sentence. + + * SB6. ATerm × Numeric */ + if (before == PL_SB_ATerm && after == PL_SB_Numeric) { + return FALSE; + } + + /* SB7. Upper ATerm × Upper */ + if (before == PL_SB_ATerm && after == PL_SB_Upper) { + temp_pos = lpos; + if (PL_SB_Upper == backup_one_SB(strbeg, &temp_pos, utf8_target)) { + return FALSE; + } + } + + /* SB8a. (STerm | ATerm) Close* Sp* × (SContinue | STerm | ATerm) + * SB10. (STerm | ATerm) Close* Sp* × ( Sp | Sep | CR | LF ) */ + backup = before; + temp_pos = lpos; + while (backup == PL_SB_Sp) { + backup = backup_one_SB(strbeg, &temp_pos, utf8_target); + } + while (backup == PL_SB_Close) { + backup = backup_one_SB(strbeg, &temp_pos, utf8_target); + } + if ((backup == PL_SB_STerm || backup == PL_SB_ATerm) + && ( after == PL_SB_SContinue + || after == PL_SB_STerm + || after == PL_SB_ATerm + || after == PL_SB_Sp + || after == PL_SB_Sep + || after == PL_SB_CR + || after == PL_SB_LF)) + { + return FALSE; + } + + /* SB8. ATerm Close* Sp* × ( ¬(OLetter | Upper | Lower | Sep | CR | LF | + * STerm | ATerm) )* Lower */ + if (backup == PL_SB_ATerm) { + U8 * rpos = (U8 *) curpos; + PL_SB_enum later = after; + + while ( later != PL_SB_OLetter + && later != PL_SB_Upper + && later != PL_SB_Lower + && later != PL_SB_Sep + && later != PL_SB_CR + && later != PL_SB_LF + && later != PL_SB_STerm + && later != PL_SB_ATerm + && later != PL_SB_EDGE) + { + later = advance_one_SB(&rpos, strend, utf8_target); + } + if (later == PL_SB_Lower) { + return FALSE; + } + } + + /* Break after sentence terminators, but include closing punctuation, + * trailing spaces, and a paragraph separator (if present). [See note + * below.] + * SB9. ( STerm | ATerm ) Close* × ( Close | Sp | Sep | CR | LF ) */ + backup = before; + temp_pos = lpos; + while (backup == PL_SB_Close) { + backup = backup_one_SB(strbeg, &temp_pos, utf8_target); + } + if ((backup == PL_SB_STerm || backup == PL_SB_ATerm) + && ( after == PL_SB_Close + || after == PL_SB_Sp + || after == PL_SB_Sep + || after == PL_SB_CR + || after == PL_SB_LF)) + { + return FALSE; + } + + + /* SB11. ( STerm | ATerm ) Close* Sp* ( Sep | CR | LF )? ÷ */ + temp_pos = lpos; + backup = backup_one_SB(strbeg, &temp_pos, utf8_target); + if ( backup == PL_SB_Sep + || backup == PL_SB_CR + || backup == PL_SB_LF) + { + lpos = temp_pos; + } + else { + backup = before; + } + while (backup == PL_SB_Sp) { + backup = backup_one_SB(strbeg, &lpos, utf8_target); + } + while (backup == PL_SB_Close) { + backup = backup_one_SB(strbeg, &lpos, utf8_target); + } + if (backup == PL_SB_STerm || backup == PL_SB_ATerm) { + return TRUE; + } + + /* Otherwise, do not break. + SB12. Any × Any */ + + return FALSE; +} + +STATIC PL_SB_enum +S_advance_one_SB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target) +{ + PL_SB_enum sb; + + PERL_ARGS_ASSERT_ADVANCE_ONE_SB; + + if (*curpos >= strend) { + return PL_SB_EDGE; + } + + if (utf8_target) { + do { + *curpos += UTF8SKIP(*curpos); + if (*curpos >= strend) { + return PL_SB_EDGE; + } + sb = getSB_VAL_UTF8(*curpos, strend); + } while (sb == PL_SB_Extend || sb == PL_SB_Format); + } + else { + do { + (*curpos)++; + if (*curpos >= strend) { + return PL_SB_EDGE; + } + sb = getSB_VAL_CP(**curpos); + } while (sb == PL_SB_Extend || sb == PL_SB_Format); + } + + return sb; +} + +STATIC PL_SB_enum +S_backup_one_SB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target) +{ + PL_SB_enum sb; + + PERL_ARGS_ASSERT_BACKUP_ONE_SB; + + if (*curpos < strbeg) { + return PL_SB_EDGE; + } + + if (utf8_target) { + U8 * prev_char_pos = reghopmaybe3(*curpos, -1, strbeg); + if (! prev_char_pos) { + return PL_SB_EDGE; + } + + /* Back up over Extend and Format. curpos is always just to the right + * of the characater whose value we are getting */ + do { + U8 * prev_prev_char_pos; + if ((prev_prev_char_pos = reghopmaybe3((U8 *) prev_char_pos, -1, + strbeg))) + { + sb = getSB_VAL_UTF8(prev_prev_char_pos, prev_char_pos); + *curpos = prev_char_pos; + prev_char_pos = prev_prev_char_pos; + } + else { + *curpos = (U8 *) strbeg; + return PL_SB_EDGE; + } + } while (sb == PL_SB_Extend || sb == PL_SB_Format); + } + else { + do { + if (*curpos - 2 < strbeg) { + *curpos = (U8 *) strbeg; + return PL_SB_EDGE; + } + (*curpos)--; + sb = getSB_VAL_CP(*(*curpos - 1)); + } while (sb == PL_SB_Extend || sb == PL_SB_Format); + } + + return sb; +} + +#define WBcase(before, after) ((PL_WB_ENUM_COUNT * before) + after) + +STATIC bool +S_isWB(pTHX_ PL_WB_enum previous, + PL_WB_enum before, + PL_WB_enum after, + const U8 * const strbeg, + const U8 * const curpos, + const U8 * const strend, + const bool utf8_target) +{ + /* Return a boolean as to if the boundary between 'before' and 'after' is + * a Unicode word break, using their published algorithm. Context may be + * needed to make this determination. If the value for the character + * before 'before' is known, it is passed as 'previous'; otherwise that + * should be set to PL_WB_UNKNOWN. The other input parameters give the + * boundaries and current position in the matching of the string. That + * is, 'curpos' marks the position where the character whose wb value is + * 'after' begins. See http://www.unicode.org/reports/tr29/ */ + + U8 * before_pos = (U8 *) curpos; + U8 * after_pos = (U8 *) curpos; + + PERL_ARGS_ASSERT_ISWB; + + /* WB1 and WB2: Break at the start and end of text. */ + if (before == PL_WB_EDGE || after == PL_WB_EDGE) { + return TRUE; + } + + /* WB 3: Do not break within CRLF. */ + if (before == PL_WB_CR && after == PL_WB_LF) { + return FALSE; + } + + /* WB 3a and WB 3b: Otherwise break before and after Newlines (including CR + * and LF) */ + if ( before == PL_WB_CR || before == PL_WB_LF || before == PL_WB_Newline + || after == PL_WB_CR || after == PL_WB_LF || after == PL_WB_Newline) + { + return TRUE; + } + + /* Ignore Format and Extend characters, except when they appear at the + * beginning of a region of text. + * WB4. X (Extend | Format)* → X. */ + + if (after == PL_WB_Extend || after == PL_WB_Format) { + return FALSE; + } + + if (before == PL_WB_Extend || before == PL_WB_Format) { + before = backup_one_WB(&previous, strbeg, &before_pos, utf8_target); + } + + switch (WBcase(before, after)) { + /* Otherwise, break everywhere (including around ideographs). + WB14. Any ÷ Any */ + default: + return TRUE; + + /* Do not break between most letters. + WB5. (ALetter | Hebrew_Letter) × (ALetter | Hebrew_Letter) */ + case WBcase(PL_WB_ALetter, PL_WB_ALetter): + case WBcase(PL_WB_ALetter, PL_WB_Hebrew_Letter): + case WBcase(PL_WB_Hebrew_Letter, PL_WB_ALetter): + case WBcase(PL_WB_Hebrew_Letter, PL_WB_Hebrew_Letter): + return FALSE; + + /* Do not break letters across certain punctuation. + WB6. (ALetter | Hebrew_Letter) + × (MidLetter | MidNumLet | Single_Quote) (ALetter + | Hebrew_Letter) */ + case WBcase(PL_WB_ALetter, PL_WB_MidLetter): + case WBcase(PL_WB_ALetter, PL_WB_MidNumLet): + case WBcase(PL_WB_ALetter, PL_WB_Single_Quote): + case WBcase(PL_WB_Hebrew_Letter, PL_WB_MidLetter): + case WBcase(PL_WB_Hebrew_Letter, PL_WB_MidNumLet): + /*case WBcase(PL_WB_Hebrew_Letter, PL_WB_Single_Quote):*/ + after = advance_one_WB(&after_pos, strend, utf8_target); + return after != PL_WB_ALetter && after != PL_WB_Hebrew_Letter; + + /* WB7. (ALetter | Hebrew_Letter) (MidLetter | MidNumLet | + * Single_Quote) × (ALetter | Hebrew_Letter) */ + case WBcase(PL_WB_MidLetter, PL_WB_ALetter): + case WBcase(PL_WB_MidLetter, PL_WB_Hebrew_Letter): + case WBcase(PL_WB_MidNumLet, PL_WB_ALetter): + case WBcase(PL_WB_MidNumLet, PL_WB_Hebrew_Letter): + case WBcase(PL_WB_Single_Quote, PL_WB_ALetter): + case WBcase(PL_WB_Single_Quote, PL_WB_Hebrew_Letter): + before + = backup_one_WB(&previous, strbeg, &before_pos, utf8_target); + return before != PL_WB_ALetter && before != PL_WB_Hebrew_Letter; + + /* WB7a. Hebrew_Letter × Single_Quote */ + case WBcase(PL_WB_Hebrew_Letter, PL_WB_Single_Quote): + return FALSE; + + /* WB7b. Hebrew_Letter × Double_Quote Hebrew_Letter */ + case WBcase(PL_WB_Hebrew_Letter, PL_WB_Double_Quote): + return advance_one_WB(&after_pos, strend, utf8_target) + != PL_WB_Hebrew_Letter; + + /* WB7c. Hebrew_Letter Double_Quote × Hebrew_Letter */ + case WBcase(PL_WB_Double_Quote, PL_WB_Hebrew_Letter): + return backup_one_WB(&previous, strbeg, &before_pos, utf8_target) + != PL_WB_Hebrew_Letter; + + /* Do not break within sequences of digits, or digits adjacent to + * letters (“3a”, or “A3”). + WB8. Numeric × Numeric */ + case WBcase(PL_WB_Numeric, PL_WB_Numeric): + return FALSE; + + /* WB9. (ALetter | Hebrew_Letter) × Numeric */ + case WBcase(PL_WB_ALetter, PL_WB_Numeric): + case WBcase(PL_WB_Hebrew_Letter, PL_WB_Numeric): + return FALSE; + + /* WB10. Numeric × (ALetter | Hebrew_Letter) */ + case WBcase(PL_WB_Numeric, PL_WB_ALetter): + case WBcase(PL_WB_Numeric, PL_WB_Hebrew_Letter): + return FALSE; + + /* Do not break within sequences, such as “3.2” or “3,456.789”. + WB11. Numeric (MidNum | MidNumLet | Single_Quote) × Numeric + */ + case WBcase(PL_WB_MidNum, PL_WB_Numeric): + case WBcase(PL_WB_MidNumLet, PL_WB_Numeric): + case WBcase(PL_WB_Single_Quote, PL_WB_Numeric): + return backup_one_WB(&previous, strbeg, &before_pos, utf8_target) + != PL_WB_Numeric; + + /* WB12. Numeric × (MidNum | MidNumLet | Single_Quote) Numeric + * */ + case WBcase(PL_WB_Numeric, PL_WB_MidNum): + case WBcase(PL_WB_Numeric, PL_WB_MidNumLet): + case WBcase(PL_WB_Numeric, PL_WB_Single_Quote): + return advance_one_WB(&after_pos, strend, utf8_target) + != PL_WB_Numeric; + + /* Do not break between Katakana. + WB13. Katakana × Katakana */ + case WBcase(PL_WB_Katakana, PL_WB_Katakana): + return FALSE; + + /* Do not break from extenders. + WB13a. (ALetter | Hebrew_Letter | Numeric | Katakana | + ExtendNumLet) × ExtendNumLet */ + case WBcase(PL_WB_ALetter, PL_WB_ExtendNumLet): + case WBcase(PL_WB_Hebrew_Letter, PL_WB_ExtendNumLet): + case WBcase(PL_WB_Numeric, PL_WB_ExtendNumLet): + case WBcase(PL_WB_Katakana, PL_WB_ExtendNumLet): + case WBcase(PL_WB_ExtendNumLet, PL_WB_ExtendNumLet): + return FALSE; + + /* WB13b. ExtendNumLet × (ALetter | Hebrew_Letter | Numeric + * | Katakana) */ + case WBcase(PL_WB_ExtendNumLet, PL_WB_ALetter): + case WBcase(PL_WB_ExtendNumLet, PL_WB_Hebrew_Letter): + case WBcase(PL_WB_ExtendNumLet, PL_WB_Numeric): + case WBcase(PL_WB_ExtendNumLet, PL_WB_Katakana): + return FALSE; + + /* Do not break between regional indicator symbols. + WB13c. Regional_Indicator × Regional_Indicator */ + case WBcase(PL_WB_Regional_Indicator, PL_WB_Regional_Indicator): + return FALSE; + + } + + NOT_REACHED; /* NOTREACHED */ +} + +STATIC PL_WB_enum +S_advance_one_WB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target) +{ + PL_WB_enum wb; + + PERL_ARGS_ASSERT_ADVANCE_ONE_WB; + + if (*curpos >= strend) { + return PL_WB_EDGE; + } + + if (utf8_target) { + + /* Advance over Extend and Format */ + do { + *curpos += UTF8SKIP(*curpos); + if (*curpos >= strend) { + return PL_WB_EDGE; + } + wb = getWB_VAL_UTF8(*curpos, strend); + } while (wb == PL_WB_Extend || wb == PL_WB_Format); + } + else { + do { + (*curpos)++; + if (*curpos >= strend) { + return PL_WB_EDGE; + } + wb = getWB_VAL_CP(**curpos); + } while (wb == PL_WB_Extend || wb == PL_WB_Format); + } + + return wb; +} + +STATIC PL_WB_enum +S_backup_one_WB(pTHX_ PL_WB_enum * previous, const U8 * const strbeg, U8 ** curpos, const bool utf8_target) +{ + PL_WB_enum wb; + + PERL_ARGS_ASSERT_BACKUP_ONE_WB; + + /* If we know what the previous character's break value is, don't have + * to look it up */ + if (*previous != PL_WB_UNKNOWN) { + wb = *previous; + *previous = PL_WB_UNKNOWN; + /* XXX Note that doesn't change curpos, and maybe should */ + + /* But we always back up over these two types */ + if (wb != PL_WB_Extend && wb != PL_WB_Format) { + return wb; + } + } + + if (*curpos < strbeg) { + return PL_WB_EDGE; + } + + if (utf8_target) { + U8 * prev_char_pos = reghopmaybe3(*curpos, -1, strbeg); + if (! prev_char_pos) { + return PL_WB_EDGE; + } + + /* Back up over Extend and Format. curpos is always just to the right + * of the characater whose value we are getting */ + do { + U8 * prev_prev_char_pos; + if ((prev_prev_char_pos = reghopmaybe3((U8 *) prev_char_pos, + -1, + strbeg))) + { + wb = getWB_VAL_UTF8(prev_prev_char_pos, prev_char_pos); + *curpos = prev_char_pos; + prev_char_pos = prev_prev_char_pos; + } + else { + *curpos = (U8 *) strbeg; + return PL_WB_EDGE; + } + } while (wb == PL_WB_Extend || wb == PL_WB_Format); + } + else { + do { + if (*curpos - 2 < strbeg) { + *curpos = (U8 *) strbeg; + return PL_WB_EDGE; + } + (*curpos)--; + wb = getWB_VAL_CP(*(*curpos - 1)); + } while (wb == PL_WB_Extend || wb == PL_WB_Format); + } + + return wb; +} + +/* returns -1 on failure, $+[0] on success */ +STATIC SSize_t +S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) +{ +#if PERL_VERSION < 9 && !defined(PERL_CORE) + dMY_CXT; +#endif + dVAR; + const bool utf8_target = reginfo->is_utf8_target; + const U32 uniflags = UTF8_ALLOW_DEFAULT; + REGEXP *rex_sv = reginfo->prog; + regexp *rex = ReANY(rex_sv); + RXi_GET_DECL(rex,rexi); + /* the current state. This is a cached copy of PL_regmatch_state */ + regmatch_state *st; + /* cache heavy used fields of st in registers */ + regnode *scan; + regnode *next; + U32 n = 0; /* general value; init to avoid compiler warning */ + SSize_t ln = 0; /* len or last; init to avoid compiler warning */ + char *locinput = startpos; + char *pushinput; /* where to continue after a PUSH */ + I32 nextchr; /* is always set to UCHARAT(locinput) */ + + bool result = 0; /* return value of S_regmatch */ + int depth = 0; /* depth of backtrack stack */ + U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */ + const U32 max_nochange_depth = + (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ? + 3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH; + regmatch_state *yes_state = NULL; /* state to pop to on success of + subpattern */ + /* mark_state piggy backs on the yes_state logic so that when we unwind + the stack on success we can update the mark_state as we go */ + regmatch_state *mark_state = NULL; /* last mark state we have seen */ + regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */ + struct regmatch_state *cur_curlyx = NULL; /* most recent curlyx */ + U32 state_num; + bool no_final = 0; /* prevent failure from backtracking? */ + bool do_cutgroup = 0; /* no_final only until next branch/trie entry */ + char *startpoint = locinput; + SV *popmark = NULL; /* are we looking for a mark? */ + SV *sv_commit = NULL; /* last mark name seen in failure */ + SV *sv_yes_mark = NULL; /* last mark name we have seen + during a successful match */ + U32 lastopen = 0; /* last open we saw */ + bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0; + SV* const oreplsv = GvSVn(PL_replgv); + /* these three flags are set by various ops to signal information to + * the very next op. They have a useful lifetime of exactly one loop + * iteration, and are not preserved or restored by state pushes/pops + */ + bool sw = 0; /* the condition value in (?(cond)a|b) */ + bool minmod = 0; /* the next "{n,m}" is a "{n,m}?" */ + int logical = 0; /* the following EVAL is: + 0: (?{...}) + 1: (?(?{...})X|Y) + 2: (??{...}) + or the following IFMATCH/UNLESSM is: + false: plain (?=foo) + true: used as a condition: (?(?=foo)) + */ + PAD* last_pad = NULL; + dMULTICALL; + I32 gimme = G_SCALAR; + CV *caller_cv = NULL; /* who called us */ + CV *last_pushed_cv = NULL; /* most recently called (?{}) CV */ + CHECKPOINT runops_cp; /* savestack position before executing EVAL */ + U32 maxopenparen = 0; /* max '(' index seen so far */ + int to_complement; /* Invert the result? */ + _char_class_number classnum; + bool is_utf8_pat = reginfo->is_utf8_pat; + bool match = FALSE; + + +#ifdef DEBUGGING + GET_RE_DEBUG_FLAGS_DECL; +#endif + + /* protect against undef(*^R) */ + SAVEFREESV(SvREFCNT_inc_simple_NN(oreplsv)); + + /* shut up 'may be used uninitialized' compiler warnings for dMULTICALL */ + multicall_oldcatch = 0; + multicall_cv = NULL; + cx = NULL; + PERL_UNUSED_VAR(multicall_cop); + PERL_UNUSED_VAR(newsp); + + + PERL_ARGS_ASSERT_REGMATCH; + + DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({ + PerlIO_printf(Perl_debug_log,"regmatch start\n"); + })); + + st = PL_regmatch_state; + + /* Note that nextchr is a byte even in UTF */ + SET_nextchr; + scan = prog; + while (scan != NULL) { DEBUG_EXECUTE_r( { SV * const prop = sv_newmortal(); regnode *rnext=regnext(scan); DUMP_EXEC_POS( locinput, scan, utf8_target ); - regprop(rex, prop, scan, reginfo); + regprop(rex, prop, scan, reginfo, NULL); PerlIO_printf(Perl_debug_log, "%3"IVdf":%*s%s(%"IVdf")\n", @@ -4019,8 +4890,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) assert(nextchr < 256 && (nextchr >= 0 || nextchr == NEXTCHR_EOS)); switch (state_num) { - case BOL: /* /^../ */ - case SBOL: /* /^../s */ + case SBOL: /* /^../ and /\A../ */ if (locinput == reginfo->strbeg) break; sayNO; @@ -4044,23 +4914,21 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) rex->offs[0].start = locinput - reginfo->strbeg; PUSH_STATE_GOTO(KEEPS_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case KEEPS_next_fail: /* rollback the start point change */ rex->offs[0].start = st->u.keeper.val; sayNO_SILENT; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case MEOL: /* /..$/m */ if (!NEXTCHR_IS_EOS && nextchr != '\n') sayNO; break; - case EOL: /* /..$/ */ - /* FALLTHROUGH */ - case SEOL: /* /..$/s */ + case SEOL: /* /..$/ */ if (!NEXTCHR_IS_EOS && nextchr != '\n') sayNO; if (reginfo->strend - locinput > 1) @@ -4103,7 +4971,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) ); sayNO_SILENT; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } /* FALLTHROUGH */ case TRIE: /* (ab|cd) */ @@ -4161,6 +5029,19 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) HV * widecharmap = MUTABLE_HV(rexi->data->data[ ARG( scan ) + 1 ]); U32 state = trie->startstate; + if (scan->flags == EXACTL || scan->flags == EXACTFLU8) { + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + if (utf8_target + && UTF8_IS_ABOVE_LATIN1(nextchr) + && scan->flags == EXACTL) + { + /* We only output for EXACTL, as we let the folder + * output this message for EXACTFLU8 to avoid + * duplication */ + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, + reginfo->strend); + } + } if ( trie->bitmap && (NEXTCHR_IS_EOS || !TRIE_BITMAP_TEST(trie, nextchr))) { @@ -4291,7 +5172,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) goto trie_first_try; /* jump into the fail handler */ }} /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case TRIE_next_fail: /* we failed - try next alternative */ { @@ -4406,14 +5287,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (ST.accepted > 1 || has_cutgroup) { PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } /* only one choice left - just continue */ DEBUG_EXECUTE_r({ AV *const trie_words = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]); - SV ** const tmp = av_fetch( trie_words, - ST.nextword-1, 0 ); + SV ** const tmp = trie_words + ? av_fetch(trie_words, ST.nextword - 1, 0) : NULL; SV *sv= tmp ? sv_newmortal() : NULL; PerlIO_printf( Perl_debug_log, @@ -4431,10 +5312,22 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) locinput = (char*)uc; continue; /* execute rest of RE */ /* NOTREACHED */ - assert(0); } #undef ST + case EXACTL: /* /abc/l */ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + + /* Complete checking would involve going through every character + * matched by the string to see if any is above latin1. But the + * comparision otherwise might very well be a fast assembly + * language routine, and I (khw) don't think slowing things down + * just to check for this warning is worth it. So this just checks + * the first character */ + if (utf8_target && UTF8_IS_ABOVE_LATIN1(*locinput)) { + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend); + } + /* FALLTHROUGH */ case EXACT: { /* /abc/ */ char *s = STRING(scan); ln = STR_LEN(scan); @@ -4521,11 +5414,24 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) const char * s; U32 fold_utf8_flags; + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; folder = foldEQ_locale; fold_array = PL_fold_locale; fold_utf8_flags = FOLDEQ_LOCALE; goto do_exactf; + case EXACTFLU8: /* /abc/il; but all 'abc' are above 255, so + is effectively /u; hence to match, target + must be UTF-8. */ + if (! utf8_target) { + sayNO; + } + fold_utf8_flags = FOLDEQ_LOCALE | FOLDEQ_S1_ALREADY_FOLDED + | FOLDEQ_S1_FOLDS_SANE; + folder = foldEQ_latin1; + fold_array = PL_fold_latin1; + goto do_exactf; + case EXACTFU_SS: /* /\x{df}/iu */ case EXACTFU: /* /abc/iu */ folder = foldEQ_latin1; @@ -4588,90 +5494,225 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) break; } - /* XXX Could improve efficiency by separating these all out using a - * macro or in-line function. At that point regcomp.c would no longer - * have to set the FLAGS fields of these */ - case BOUNDL: /* /\b/l */ case NBOUNDL: /* /\B/l */ + to_complement = 1; + /* FALLTHROUGH */ + + case BOUNDL: /* /\b/l */ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + + if (FLAGS(scan) != TRADITIONAL_BOUND) { + if (! IN_UTF8_CTYPE_LOCALE) { + Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), + B_ON_NON_UTF8_LOCALE_IS_WRONG); + } + goto boundu; + } + + if (utf8_target) { + if (locinput == reginfo->strbeg) + ln = isWORDCHAR_LC('\n'); + else { + ln = isWORDCHAR_LC_utf8(reghop3((U8*)locinput, -1, + (U8*)(reginfo->strbeg))); + } + n = (NEXTCHR_IS_EOS) + ? isWORDCHAR_LC('\n') + : isWORDCHAR_LC_utf8((U8*)locinput); + } + else { /* Here the string isn't utf8 */ + ln = (locinput == reginfo->strbeg) + ? isWORDCHAR_LC('\n') + : isWORDCHAR_LC(UCHARAT(locinput - 1)); + n = (NEXTCHR_IS_EOS) + ? isWORDCHAR_LC('\n') + : isWORDCHAR_LC(nextchr); + } + if (to_complement ^ (ln == n)) { + sayNO; + } + break; + + case NBOUND: /* /\B/ */ + to_complement = 1; + /* FALLTHROUGH */ + case BOUND: /* /\b/ */ - case BOUNDU: /* /\b/u */ + if (utf8_target) { + goto bound_utf8; + } + goto bound_ascii_match_only; + + case NBOUNDA: /* /\B/a */ + to_complement = 1; + /* FALLTHROUGH */ + case BOUNDA: /* /\b/a */ - case NBOUND: /* /\B/ */ + + bound_ascii_match_only: + /* Here the string isn't utf8, or is utf8 and only ascii characters + * are to match \w. In the latter case looking at the byte just + * prior to the current one may be just the final byte of a + * multi-byte character. This is ok. There are two cases: + * 1) it is a single byte character, and then the test is doing + * just what it's supposed to. + * 2) it is a multi-byte character, in which case the final byte is + * never mistakable for ASCII, and so the test will say it is + * not a word character, which is the correct answer. */ + ln = (locinput == reginfo->strbeg) + ? isWORDCHAR_A('\n') + : isWORDCHAR_A(UCHARAT(locinput - 1)); + n = (NEXTCHR_IS_EOS) + ? isWORDCHAR_A('\n') + : isWORDCHAR_A(nextchr); + if (to_complement ^ (ln == n)) { + sayNO; + } + break; + case NBOUNDU: /* /\B/u */ - case NBOUNDA: /* /\B/a */ - /* was last char in word? */ - if (utf8_target - && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET - && FLAGS(scan) != REGEX_ASCII_MORE_RESTRICTED_CHARSET) - { - if (locinput == reginfo->strbeg) - ln = '\n'; - else { - const U8 * const r = - reghop3((U8*)locinput, -1, (U8*)(reginfo->strbeg)); + to_complement = 1; + /* FALLTHROUGH */ - ln = utf8n_to_uvchr(r, (U8*) reginfo->strend - r, - 0, uniflags); - } - if (FLAGS(scan) != REGEX_LOCALE_CHARSET) { - ln = isWORDCHAR_uni(ln); - if (NEXTCHR_IS_EOS) - n = 0; - else { - LOAD_UTF8_CHARCLASS_ALNUM(); - n = swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)locinput, - utf8_target); - } - } - else { - ln = isWORDCHAR_LC_uvchr(ln); - n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_LC_utf8((U8*)locinput); - } + case BOUNDU: /* /\b/u */ + + boundu: + if (utf8_target) { + + bound_utf8: + switch((bound_type) FLAGS(scan)) { + case TRADITIONAL_BOUND: + ln = (locinput == reginfo->strbeg) + ? isWORDCHAR_L1('\n') + : isWORDCHAR_utf8(reghop3((U8*)locinput, -1, + (U8*)(reginfo->strbeg))); + n = (NEXTCHR_IS_EOS) + ? isWORDCHAR_L1('\n') + : isWORDCHAR_utf8((U8*)locinput); + match = cBOOL(ln != n); + break; + case GCB_BOUND: + if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) { + match = TRUE; /* GCB always matches at begin and + end */ + } + else { + /* Find the gcb values of previous and current + * chars, then see if is a break point */ + match = isGCB(getGCB_VAL_UTF8( + reghop3((U8*)locinput, + -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend), + getGCB_VAL_UTF8((U8*) locinput, + (U8*) reginfo->strend)); + } + break; + + case SB_BOUND: /* Always matches at begin and end */ + if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) { + match = TRUE; + } + else { + match = isSB(getSB_VAL_UTF8( + reghop3((U8*)locinput, + -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend), + getSB_VAL_UTF8((U8*) locinput, + (U8*) reginfo->strend), + (U8*) reginfo->strbeg, + (U8*) locinput, + (U8*) reginfo->strend, + utf8_target); + } + break; + + case WB_BOUND: + if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) { + match = TRUE; + } + else { + match = isWB(PL_WB_UNKNOWN, + getWB_VAL_UTF8( + reghop3((U8*)locinput, + -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend), + getWB_VAL_UTF8((U8*) locinput, + (U8*) reginfo->strend), + (U8*) reginfo->strbeg, + (U8*) locinput, + (U8*) reginfo->strend, + utf8_target); + } + break; + } } - else { + else { /* Not utf8 target */ + switch((bound_type) FLAGS(scan)) { + case TRADITIONAL_BOUND: + ln = (locinput == reginfo->strbeg) + ? isWORDCHAR_L1('\n') + : isWORDCHAR_L1(UCHARAT(locinput - 1)); + n = (NEXTCHR_IS_EOS) + ? isWORDCHAR_L1('\n') + : isWORDCHAR_L1(nextchr); + match = cBOOL(ln != n); + break; - /* Here the string isn't utf8, or is utf8 and only ascii - * characters are to match \w. In the latter case looking at - * the byte just prior to the current one may be just the final - * byte of a multi-byte character. This is ok. There are two - * cases: - * 1) it is a single byte character, and then the test is doing - * just what it's supposed to. - * 2) it is a multi-byte character, in which case the final - * byte is never mistakable for ASCII, and so the test - * will say it is not a word character, which is the - * correct answer. */ - ln = (locinput != reginfo->strbeg) ? - UCHARAT(locinput - 1) : '\n'; - switch (FLAGS(scan)) { - case REGEX_UNICODE_CHARSET: - ln = isWORDCHAR_L1(ln); - n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_L1(nextchr); - break; - case REGEX_LOCALE_CHARSET: - ln = isWORDCHAR_LC(ln); - n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_LC(nextchr); - break; - case REGEX_DEPENDS_CHARSET: - ln = isWORDCHAR(ln); - n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR(nextchr); - break; - case REGEX_ASCII_RESTRICTED_CHARSET: - case REGEX_ASCII_MORE_RESTRICTED_CHARSET: - ln = isWORDCHAR_A(ln); - n = NEXTCHR_IS_EOS ? 0 : isWORDCHAR_A(nextchr); - break; - default: - Perl_croak(aTHX_ "panic: Unexpected FLAGS %u in op %u", FLAGS(scan), OP(scan)); - } + case GCB_BOUND: + if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) { + match = TRUE; /* GCB always matches at begin and + end */ + } + else { /* Only CR-LF combo isn't a GCB in 0-255 + range */ + match = UCHARAT(locinput - 1) != '\r' + || UCHARAT(locinput) != '\n'; + } + break; + + case SB_BOUND: /* Always matches at begin and end */ + if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) { + match = TRUE; + } + else { + match = isSB(getSB_VAL_CP(UCHARAT(locinput -1)), + getSB_VAL_CP(UCHARAT(locinput)), + (U8*) reginfo->strbeg, + (U8*) locinput, + (U8*) reginfo->strend, + utf8_target); + } + break; + + case WB_BOUND: + if (locinput == reginfo->strbeg || NEXTCHR_IS_EOS) { + match = TRUE; + } + else { + match = isWB(PL_WB_UNKNOWN, + getWB_VAL_CP(UCHARAT(locinput -1)), + getWB_VAL_CP(UCHARAT(locinput)), + (U8*) reginfo->strbeg, + (U8*) locinput, + (U8*) reginfo->strend, + utf8_target); + } + break; + } } - /* Note requires that all BOUNDs be lower than all NBOUNDs in - * regcomp.sym */ - if (((!ln) == (!n)) == (OP(scan) < NBOUND)) - sayNO; + + if (to_complement ^ ! match) { + sayNO; + } break; - case ANYOF: /* /[abc]/ */ + case ANYOFL: /* /[abc]/l */ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + /* FALLTHROUGH */ + case ANYOF: /* /[abc]/ */ if (NEXTCHR_IS_EOS) sayNO; if (utf8_target) { @@ -4695,6 +5736,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* FALLTHROUGH */ case POSIXL: /* \w or [:punct:] etc. under /l */ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; if (NEXTCHR_IS_EOS) sayNO; @@ -4715,7 +5757,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } } else { /* Here, must be an above Latin-1 code point */ - goto utf8_posix_not_eos; + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend); + goto utf8_posix_above_latin1; } /* Here, must be utf8 */ @@ -4774,7 +5817,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (NEXTCHR_IS_EOS) { sayNO; } - utf8_posix_not_eos: /* Use _generic_isCC() for characters within Latin1. (Note that * UTF8_IS_INVARIANT works even on non-UTF-8 strings, or else @@ -4798,6 +5840,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) locinput += 2; } else { /* Handle above Latin-1 code points */ + utf8_posix_above_latin1: classnum = (_char_class_number) FLAGS(scan); if (classnum < _FIRST_NON_SWASH_CC) { @@ -4820,10 +5863,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } else { /* Here, uses macros to find above Latin-1 code points */ switch (classnum) { - case _CC_ENUM_SPACE: /* XXX would require separate - code if we revert the change - of \v matching this */ - case _CC_ENUM_PSXSPC: + case _CC_ENUM_SPACE: if (! (to_complement ^ cBOOL(is_XPERLSPACE_high(locinput)))) { @@ -4865,38 +5905,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) case CLUMP: /* Match \X: logical Unicode character. This is defined as a Unicode extended Grapheme Cluster */ - /* From http://www.unicode.org/reports/tr29 (5.2 version). An - extended Grapheme Cluster is: - - CR LF - | Prepend* Begin Extend* - | . - - Begin is: ( Special_Begin | ! Control ) - Special_Begin is: ( Regional-Indicator+ | Hangul-syllable ) - Extend is: ( Grapheme_Extend | Spacing_Mark ) - Control is: [ GCB_Control | CR | LF ] - Hangul-syllable is: ( T+ | ( L* ( L | ( LVT | ( V | LV ) V* ) T* ) )) - - If we create a 'Regular_Begin' = Begin - Special_Begin, then - we can rewrite - - Begin is ( Regular_Begin + Special Begin ) - - It turns out that 98.4% of all Unicode code points match - Regular_Begin. Doing it this way eliminates a table match in - the previous implementation for almost all Unicode code points. - - 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 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 (NEXTCHR_IS_EOS) sayNO; if (! utf8_target) { @@ -4914,147 +5922,27 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } else { - /* Utf8: See if is ( CR LF ); already know that locinput < - * reginfo->strend, so locinput+1 is in bounds */ - if ( nextchr == '\r' && locinput+1 < reginfo->strend - && UCHARAT(locinput + 1) == '\n') - { - locinput += 2; - } - else { - STRLEN len; - - /* In case have to backtrack to beginning, then match '.' */ - char *starting = locinput; + /* Get the gcb type for the current character */ + PL_GCB_enum prev_gcb = getGCB_VAL_UTF8((U8*) locinput, + (U8*) reginfo->strend); - /* In case have to backtrack the last prepend */ - char *previous_prepend = NULL; - - LOAD_UTF8_CHARCLASS_GCB(); - - /* Match (prepend)* */ - while (locinput < reginfo->strend - && (len = is_GCB_Prepend_utf8(locinput))) - { - previous_prepend = locinput; - locinput += len; - } - - /* As noted above, if we matched a prepend character, but - * the next thing won't match, back off the last prepend we - * matched, as it is guaranteed to match the begin */ - if (previous_prepend - && (locinput >= reginfo->strend - || (! swash_fetch(PL_utf8_X_regular_begin, - (U8*)locinput, utf8_target) - && ! is_GCB_SPECIAL_BEGIN_START_utf8(locinput))) - ) - { - locinput = previous_prepend; - } - - /* Note that here we know reginfo->strend > locinput, as we - * tested that upon input to this switch case, and if we - * moved locinput forward, we tested the result just above - * and it either passed, or we backed off so that it will - * now pass */ - if (swash_fetch(PL_utf8_X_regular_begin, - (U8*)locinput, utf8_target)) { - locinput += UTF8SKIP(locinput); + /* Then scan through the input until we get to the first + * character whose type is supposed to be a gcb with the + * current character. (There is always a break at the + * end-of-input) */ + locinput += UTF8SKIP(locinput); + while (locinput < reginfo->strend) { + PL_GCB_enum cur_gcb = getGCB_VAL_UTF8((U8*) locinput, + (U8*) reginfo->strend); + if (isGCB(prev_gcb, cur_gcb)) { + break; } - else if (! is_GCB_SPECIAL_BEGIN_START_utf8(locinput)) { - - /* Here did not match the required 'Begin' in the - * second term. So just match the very first - * character, the '.' of the final term of the regex */ - locinput = starting + UTF8SKIP(starting); - goto exit_utf8; - } else { - - /* Here is a special begin. It can be composed of - * several individual characters. One possibility is - * RI+ */ - if ((len = is_GCB_RI_utf8(locinput))) { - locinput += len; - while (locinput < reginfo->strend - && (len = is_GCB_RI_utf8(locinput))) - { - locinput += len; - } - } else if ((len = is_GCB_T_utf8(locinput))) { - /* Another possibility is T+ */ - locinput += len; - while (locinput < reginfo->strend - && (len = is_GCB_T_utf8(locinput))) - { - locinput += len; - } - } else { - - /* Here, neither RI+ nor T+; must be some other - * Hangul. That means it is one of the others: L, - * LV, LVT or V, and matches: - * L* (L | LVT T* | V * V* T* | LV V* T*) */ - /* Match L* */ - while (locinput < reginfo->strend - && (len = is_GCB_L_utf8(locinput))) - { - locinput += len; - } + prev_gcb = cur_gcb; + locinput += UTF8SKIP(locinput); + } - /* Here, have exhausted L*. If the next character - * is not an LV, LVT nor V, it means we had to have - * at least one L, so matches L+ in the original - * equation, we have a complete hangul syllable. - * Are done. */ - if (locinput < reginfo->strend - && is_GCB_LV_LVT_V_utf8(locinput)) - { - /* Otherwise keep going. Must be LV, LVT or V. - * See if LVT, by first ruling out V, then LV */ - if (! is_GCB_V_utf8(locinput) - /* All but every TCount one is LV */ - && (valid_utf8_to_uvchr((U8 *) locinput, - NULL) - - SBASE) - % TCount != 0) - { - locinput += UTF8SKIP(locinput); - } else { - - /* Must be V or LV. Take it, then match - * V* */ - locinput += UTF8SKIP(locinput); - while (locinput < reginfo->strend - && (len = is_GCB_V_utf8(locinput))) - { - locinput += len; - } - } - - /* And any of LV, LVT, or V can be followed - * by T* */ - while (locinput < reginfo->strend - && (len = is_GCB_T_utf8(locinput))) - { - locinput += len; - } - } - } - } - - /* Match any extender */ - while (locinput < reginfo->strend - && swash_fetch(PL_utf8_X_extend, - (U8*)locinput, utf8_target)) - { - locinput += UTF8SKIP(locinput); - } - } - exit_utf8: - if (locinput > reginfo->strend) sayNO; } break; @@ -5071,6 +5959,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) const U8 *fold_array; UV utf8_fold_flags; + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; folder = foldEQ_locale; fold_array = PL_fold_locale; type = REFFL; @@ -5115,6 +6004,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) goto do_nref_ref_common; case REFFL: /* /\1/il */ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; folder = foldEQ_locale; fold_array = PL_fold_locale; utf8_fold_flags = FOLDEQ_LOCALE; @@ -5198,9 +6088,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) case TAIL: /* placeholder while compiling (A|B|C) */ break; - case BACK: /* ??? doesn't appear to be used ??? */ - break; - #undef ST #define ST st->u.eval { @@ -5239,9 +6126,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* and then jump to the code we share with EVAL */ goto eval_recurse_doit; - /* NOTREACHED */ - assert(0); case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */ if (cur_eval && cur_eval->locinput==locinput) { @@ -5330,7 +6215,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) assert(o->op_targ == OP_LEAVE); o = cUNOPo->op_first; assert(o->op_type == OP_ENTER); - o = OP_SIBLING(o); + o = OpSIBLING(o); } if (o->op_type != OP_STUB) { @@ -5456,8 +6341,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) assert(!(scan->flags & ~RXf_PMf_COMPILETIME)); re_sv = rex->engine->op_comp(aTHX_ &ret, 1, NULL, rex->engine, NULL, NULL, - /* copy /msix etc to inner pattern */ - scan->flags, + /* copy /msixn etc to inner pattern */ + ARG2L(scan), pm_flags); if (!(SvFLAGS(ret) @@ -5493,7 +6378,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) maxopenparen = 0; /* run the pattern returned from (??{...}) */ - eval_recurse_doit: /* Share code with GOSUB below this line + eval_recurse_doit: /* Share code with GOSUB below this line * At this point we expect the stack context to be * set up correctly */ @@ -5523,7 +6408,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* now continue from first node in postoned RE */ PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } case EVAL_AB: /* cleanup after a successful (??{A})B */ @@ -5783,21 +6668,21 @@ NULL PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next), locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } case CURLYX_end: /* just finished matching all of A*B */ cur_curlyx = ST.prev_curlyx; sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CURLYX_end_fail: /* just failed to match all of A*B */ regcpblow(ST.cp); cur_curlyx = ST.prev_curlyx; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ #undef ST @@ -5836,7 +6721,7 @@ NULL PUSH_STATE_GOTO(WHILEM_A_pre, A, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } /* If degenerate A matches "", assume A done. */ @@ -5949,7 +6834,7 @@ NULL PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } /* Prefer A over B for maximal matching. */ @@ -5961,19 +6846,19 @@ NULL REGCP_SET(ST.lastcp); PUSH_STATE_GOTO(WHILEM_A_max, A, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } goto do_whilem_B_max; } /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case WHILEM_B_min: /* just matched B in a minimal match */ case WHILEM_B_max: /* just matched B in a maximal match */ cur_curlyx = ST.save_curlyx; sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case WHILEM_B_max_fail: /* just failed to match B in a maximal match */ cur_curlyx = ST.save_curlyx; @@ -5981,7 +6866,7 @@ NULL cur_curlyx->u.curlyx.count--; CACHEsayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case WHILEM_A_min_fail: /* just failed to match A in a minimal match */ /* FALLTHROUGH */ @@ -5992,7 +6877,7 @@ NULL cur_curlyx->u.curlyx.count--; CACHEsayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case WHILEM_A_max_fail: /* just failed to match A in a maximal match */ REGCP_UNWIND(ST.lastcp); @@ -6019,7 +6904,7 @@ NULL PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case WHILEM_B_min_fail: /* just failed to match B in a minimal match */ cur_curlyx = ST.save_curlyx; @@ -6054,7 +6939,7 @@ NULL /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ #undef ST #define ST st->u.branch @@ -6080,14 +6965,14 @@ NULL PUSH_STATE_GOTO(BRANCH_next, scan, locinput); } /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CUTGROUP: /* /(*THEN)/ */ sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL : MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); PUSH_STATE_GOTO(CUTGROUP_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CUTGROUP_next_fail: do_cutgroup = 1; @@ -6096,12 +6981,12 @@ NULL sv_commit = st->u.mark.mark_name; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case BRANCH_next: sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case BRANCH_next_fail: /* that branch failed; try the next, if any */ if (do_cutgroup) { @@ -6124,7 +7009,6 @@ NULL } continue; /* execute next BRANCH[J] op */ /* NOTREACHED */ - assert(0); case MINMOD: /* next op will be non-greedy, e.g. A*? */ minmod = 1; @@ -6169,7 +7053,7 @@ NULL curlym_do_A: /* execute the A in /A{m,n}B/ */ PUSH_YES_STATE_GOTO(CURLYM_A, ST.A, locinput); /* match A */ /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CURLYM_A: /* we've just matched an A */ ST.count++; @@ -6306,7 +7190,7 @@ NULL PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */ /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CURLYM_B_fail: /* just failed to match a B */ REGCP_UNWIND(ST.cp); @@ -6485,7 +7369,7 @@ NULL goto curly_try_B_max; } /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CURLY_B_min_known_fail: /* failed to find B in a non-greedy match where c1,c2 valid */ @@ -6561,7 +7445,7 @@ NULL PUSH_STATE_GOTO(CURLY_B_min_known, ST.B, locinput); } /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case CURLY_B_min_fail: /* failed to find B in a non-greedy match where c1,c2 invalid */ @@ -6594,9 +7478,9 @@ NULL } sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ - curly_try_B_max: + curly_try_B_max: /* a successful greedy match: now try to match B */ if (cur_eval && cur_eval->u.eval.close_paren && cur_eval->u.eval.close_paren == (U32)ST.paren) { @@ -6625,7 +7509,7 @@ NULL CURLY_SETPAREN(ST.paren, ST.count); PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } } /* FALLTHROUGH */ @@ -6646,7 +7530,7 @@ NULL #undef ST case END: /* last op of main pattern */ - fake_end: + fake_end: if (cur_eval) { /* we've just finished A in /(??{A})B/; now continue with B */ @@ -6745,7 +7629,7 @@ NULL /* execute body of (?...A) */ PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)), newstart); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } case IFMATCH_A_fail: /* body of (?...A) failed */ @@ -6786,7 +7670,7 @@ NULL sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); PUSH_STATE_GOTO(COMMIT_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case COMMIT_next_fail: no_final = 1; @@ -6795,7 +7679,7 @@ NULL case OPFAIL: /* (*FAIL) */ sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ #define ST st->u.mark case MARKPOINT: /* (*MARK:foo) */ @@ -6806,13 +7690,13 @@ NULL ST.mark_loc = locinput; PUSH_YES_STATE_GOTO(MARKPOINT_next, next, locinput); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case MARKPOINT_next: mark_state = ST.prev_mark; sayYES; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case MARKPOINT_next_fail: if (popmark && sv_eq(ST.mark_name,popmark)) @@ -6834,7 +7718,7 @@ NULL mark_state->u.mark.mark_name : NULL; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ case SKIP: /* (*SKIP) */ if (scan->flags) { @@ -6880,7 +7764,7 @@ NULL no_final = 1; sayNO; /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ #undef ST case LNBREAK: /* \R */ @@ -6897,7 +7781,7 @@ NULL /* this is a point to jump to in order to increment * locinput by one character */ - increment_locinput: + increment_locinput: assert(!NEXTCHR_IS_EOS); if (utf8_target) { locinput += PL_utf8skip[nextchr]; @@ -6915,7 +7799,6 @@ NULL scan = next; /* prepare to execute the next op and ... */ continue; /* ... jump back to the top, reusing st */ /* NOTREACHED */ - assert(0); push_yes_state: /* push a state that backtracks on success */ @@ -6959,7 +7842,6 @@ NULL st = newst; continue; /* NOTREACHED */ - assert(0); } } @@ -6970,8 +7852,9 @@ NULL Perl_croak(aTHX_ "corrupted regexp pointers"); /* NOTREACHED */ sayNO; + NOT_REACHED; /* NOTREACHED */ -yes: + yes: if (yes_state) { /* we have successfully completed a subexpression, but we must now * pop to the state marked by yes_state and continue from there */ @@ -7032,7 +7915,7 @@ yes: result = 1; goto final_exit; -no: + no: DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "%*s %sfailed...%s\n", @@ -7040,7 +7923,7 @@ no: PL_colors[4], PL_colors[5]) ); -no_silent: + no_silent: if (no_final) { if (yes_state) { goto yes; @@ -7121,7 +8004,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, char *loceol = reginfo->strend; /* local version */ I32 hardcount = 0; /* How many matches so far */ bool utf8_target = reginfo->is_utf8_target; - int to_complement = 0; /* Invert the result? */ + unsigned int to_complement = 0; /* Invert the result? */ UV utf8_flags; _char_class_number classnum; #ifndef DEBUGGING @@ -7191,6 +8074,12 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, scan = loceol; } break; + case EXACTL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + if (utf8_target && UTF8_IS_ABOVE_LATIN1(*scan)) { + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(scan, loceol); + } + /* FALLTHROUGH */ case EXACT: assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1); @@ -7264,6 +8153,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, goto do_exactf; case EXACTFL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; utf8_flags = FOLDEQ_LOCALE; goto do_exactf; @@ -7272,11 +8162,19 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, utf8_flags = 0; goto do_exactf; + case EXACTFLU8: + if (! utf8_target) { + break; + } + utf8_flags = FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED + | FOLDEQ_S2_FOLDS_SANE; + goto do_exactf; + case EXACTFU_SS: case EXACTFU: utf8_flags = reginfo->is_utf8_pat ? FOLDEQ_S2_ALREADY_FOLDED : 0; - do_exactf: { + do_exactf: { int c1, c2; U8 c1_utf8[UTF8_MAXBYTES+1], c2_utf8[UTF8_MAXBYTES+1]; @@ -7335,6 +8233,9 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, } break; } + case ANYOFL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + /* FALLTHROUGH */ case ANYOF: if (utf8_target) { while (hardcount < max @@ -7357,6 +8258,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, /* FALLTHROUGH */ case POSIXL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; if (! utf8_target) { while (scan < loceol && to_complement ^ cBOOL(isFOO_lc(FLAGS(p), *scan))) @@ -7433,7 +8335,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, } } else { - utf8_posix: + utf8_posix: classnum = (_char_class_number) FLAGS(p); if (classnum < _FIRST_NON_SWASH_CC) { @@ -7476,11 +8378,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, * code is written for making the loops as tight as possible. * It could be refactored to save space instead */ switch (classnum) { - case _CC_ENUM_SPACE: /* XXX would require separate code - if we revert the change of \v - matching this */ - /* FALLTHROUGH */ - case _CC_ENUM_PSXSPC: + case _CC_ENUM_SPACE: while (hardcount < max && scan < loceol && (to_complement ^ cBOOL(isSPACE_utf8(scan)))) @@ -7576,16 +8474,18 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, } break; + case BOUNDL: + case NBOUNDL: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; + /* FALLTHROUGH */ case BOUND: case BOUNDA: - case BOUNDL: case BOUNDU: case EOS: case GPOS: case KEEPS: case NBOUND: case NBOUNDA: - case NBOUNDL: case NBOUNDU: case OPFAIL: case SBOL: @@ -7596,7 +8496,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, default: Perl_croak(aTHX_ "panic: regrepeat() called with unrecognized node type %d='%s'", OP(p), PL_reg_name[OP(p)]); /* NOTREACHED */ - assert(0); + NOT_REACHED; /* NOTREACHED */ } @@ -7610,7 +8510,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, GET_RE_DEBUG_FLAGS_DECL; DEBUG_EXECUTE_r({ SV * const prop = sv_newmortal(); - regprop(prog, prop, p, reginfo); + regprop(prog, prop, p, reginfo, NULL); PerlIO_printf(Perl_debug_log, "%*s %s can match %"IVdf" times out of %"IVdf"...\n", REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max); @@ -7636,127 +8536,15 @@ Perl_regclass_swash(pTHX_ const regexp *prog, const regnode* node, bool doinit, *altsvp = NULL; } - return newSVsv(_get_regclass_nonbitmap_data(prog, node, doinit, listsvp, NULL)); + return newSVsv(_get_regclass_nonbitmap_data(prog, node, doinit, listsvp, NULL, NULL)); } -SV * -Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog, - const regnode* node, - bool doinit, - SV** listsvp, - SV** only_utf8_locale_ptr) -{ - /* For internal core use only. - * 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 printable contents of the - * swash. This can be used to get debugging information even before the - * swash exists, by calling this function with 'doinit' set to false, in - * which case the components that will be used to eventually create the - * swash are returned (in a printable form). - * Tied intimately to how regcomp.c sets up the data structure */ - - SV *sw = NULL; - SV *si = NULL; /* Input swash initialization string */ - SV* invlist = NULL; - - RXi_GET_DECL(prog,progi); - const struct reg_data * const data = prog ? progi->data : NULL; - - PERL_ARGS_ASSERT__GET_REGCLASS_NONBITMAP_DATA; - - assert(ANYOF_FLAGS(node) - & (ANYOF_UTF8|ANYOF_NONBITMAP_NON_UTF8|ANYOF_LOC_FOLD)); - - if (data && data->count) { - const U32 n = ARG(node); - - if (data->what[n] == 's') { - SV * const rv = MUTABLE_SV(data->data[n]); - AV * const av = MUTABLE_AV(SvRV(rv)); - SV **const ary = AvARRAY(av); - U8 swash_init_flags = _CORE_SWASH_INIT_ACCEPT_INVLIST; - - 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_tindex(av) >= 2) { - if (only_utf8_locale_ptr - && ary[2] - && ary[2] != &PL_sv_undef) - { - *only_utf8_locale_ptr = ary[2]; - } - else { - assert(only_utf8_locale_ptr); - *only_utf8_locale_ptr = NULL; - } - - if (av_tindex(av) >= 3) { - invlist = ary[3]; - if (SvUV(ary[4])) { - swash_init_flags |= _CORE_SWASH_INIT_USER_DEFINED_PROPERTY; - } - } - else { - invlist = NULL; - } - } - - /* Element [1] is reserved for the set-up swash. If already there, - * return it; if not, create it and store it there */ - if (ary[1] && SvROK(ary[1])) { - sw = ary[1]; - } - else if (doinit && ((si && si != &PL_sv_undef) - || (invlist && invlist != &PL_sv_undef))) { - assert(si); - sw = _core_swash_init("utf8", /* the utf8 package */ - "", /* nameless */ - si, - 1, /* binary */ - 0, /* not from tr/// */ - invlist, - &swash_init_flags); - (void)av_store(av, 1, sw); - } - } - } - - /* If requested, return a printable version of what this swash matches */ - if (listsvp) { - SV* matches_string = newSVpvs(""); - - /* The swash should be used, if possible, to get the data, as it - * contains the resolved data. But this function can be called at - * compile-time, before everything gets resolved, in which case we - * return the currently best available information, which is the string - * that will eventually be used to do that resolving, 'si' */ - if ((! sw || (invlist = _get_swash_invlist(sw)) == NULL) - && (si && si != &PL_sv_undef)) - { - 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; - } - - return sw; -} #endif /* !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) */ /* - reginclass - determine if a character falls into a character class - n is the ANYOF regnode + n is the ANYOF-type regnode p is the target string p_end points to one byte beyond the end of the target string utf8_target tells whether p is in UTF-8. @@ -7790,25 +8578,31 @@ S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const * UTF8_ALLOW_FFFF */ if (c_len == (STRLEN)-1) Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)"); + if (c > 255 && OP(n) == ANYOFL && ! is_ANYOF_SYNTHETIC(n)) { + _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(c); + } } /* If this character is potentially in the bitmap, check it */ - if (c < 256) { + if (c < NUM_ANYOF_CODE_POINTS) { if (ANYOF_BITMAP_TEST(n, c)) match = TRUE; - else if (flags & ANYOF_NON_UTF8_NON_ASCII_ALL - && ! utf8_target - && ! isASCII(c)) + else if ((flags & ANYOF_MATCHES_ALL_NON_UTF8_NON_ASCII) + && ! utf8_target + && ! isASCII(c)) { match = TRUE; } else if (flags & ANYOF_LOCALE_FLAGS) { - if (flags & ANYOF_LOC_FOLD) { - if (ANYOF_BITMAP_TEST(n, PL_fold_locale[c])) { - match = TRUE; - } + if ((flags & ANYOF_LOC_FOLD) + && c < 256 + && ANYOF_BITMAP_TEST(n, PL_fold_locale[c])) + { + match = TRUE; } - if (! match && ANYOF_POSIXL_TEST_ANY_SET(n)) { + else if (ANYOF_POSIXL_TEST_ANY_SET(n) + && c < 256 + ) { /* The data structure is arranged so bits 0, 2, 4, ... are set * if the class includes the Posix character class given by @@ -7861,18 +8655,20 @@ S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const /* If the bitmap didn't (or couldn't) match, and something outside the * bitmap could match, try that. */ if (!match) { - if (c >= 256 && (flags & ANYOF_ABOVE_LATIN1_ALL)) { - match = TRUE; /* Everything above 255 matches */ + if (c >= NUM_ANYOF_CODE_POINTS + && (flags & ANYOF_MATCHES_ALL_ABOVE_BITMAP)) + { + match = TRUE; /* Everything above the bitmap matches */ } - else if ((flags & ANYOF_NONBITMAP_NON_UTF8) - || (utf8_target && (flags & ANYOF_UTF8)) + else if ((flags & ANYOF_HAS_NONBITMAP_NON_UTF8_MATCHES) + || (utf8_target && (flags & ANYOF_HAS_UTF8_NONBITMAP_MATCHES)) || ((flags & ANYOF_LOC_FOLD) && IN_UTF8_CTYPE_LOCALE - && ARG(n) != ANYOF_NONBITMAP_EMPTY)) + && ARG(n) != ANYOF_ONLY_HAS_BITMAP)) { SV* only_utf8_locale = NULL; SV * const sw = _get_regclass_nonbitmap_data(prog, n, TRUE, 0, - &only_utf8_locale); + &only_utf8_locale, NULL); if (sw) { U8 utf8_buffer[2]; U8 * utf8_p;