X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/97136c8a5affa3c46e244cc603af319eafb3938b..0fbfbb97fd8bda2b2f51041f575b8e41691c21f0:/regexec.c diff --git a/regexec.c b/regexec.c index 368b52b..e74ca18 100644 --- a/regexec.c +++ b/regexec.c @@ -119,6 +119,7 @@ static const char* const non_utf8_target_but_utf8_required ? reghop3((U8*)pos, off, \ (U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \ : (U8*)(pos + off)) + #define HOPBACKc(pos, off) \ (char*)(reginfo->is_utf8_target \ ? reghopmaybe3((U8*)pos, -off, (U8*)(reginfo->strbeg)) \ @@ -129,6 +130,14 @@ static const char* const non_utf8_target_but_utf8_required #define HOP3(pos,off,lim) (reginfo->is_utf8_target ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off)) #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim)) +/* lim must be +ve. Returns NULL on overshoot */ +#define HOPMAYBE3(pos,off,lim) \ + (reginfo->is_utf8_target \ + ? reghopmaybe3((U8*)pos, off, (U8*)(lim)) \ + : ((U8*)pos + off <= lim) \ + ? (U8*)pos + off \ + : NULL) + /* like HOP3, but limits the result to <= lim even for the non-utf8 case. * off must be >=0; args should be vars rather than expressions */ #define HOP3lim(pos,off,lim) (reginfo->is_utf8_target \ @@ -279,7 +288,6 @@ static regmatch_state * S_push_slab(pTHX); STATIC CHECKPOINT S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) { - dVAR; const int retval = PL_savestack_ix; const int paren_elems_to_push = (maxopenparen - parenfloor) * REGCP_PAREN_ELEMS; @@ -291,8 +299,9 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) PERL_ARGS_ASSERT_REGCPPUSH; if (paren_elems_to_push < 0) - Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %i", - paren_elems_to_push, maxopenparen, parenfloor, REGCP_PAREN_ELEMS); + Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %u", + (int)paren_elems_to_push, (int)maxopenparen, + (int)parenfloor, (unsigned)REGCP_PAREN_ELEMS); if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems) Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf @@ -359,7 +368,6 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) STATIC void S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p) { - dVAR; UV i; U32 paren; GET_RE_DEBUG_FLAGS_DECL; @@ -528,12 +536,10 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* 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; } - assert(0); /* NOTREACHED */ - return FALSE; + return FALSE; /* Things like CNTRL are always below 256 */ } /* @@ -563,64 +569,70 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend, } #endif -/* - * Need to implement the following flags for reg_anch: - * - * USE_INTUIT_NOML - Useful to call re_intuit_start() first - * USE_INTUIT_ML - * INTUIT_AUTORITATIVE_NOML - Can trust a positive answer - * INTUIT_AUTORITATIVE_ML - * INTUIT_ONCE_NOML - Intuit can match in one location only. - * INTUIT_ONCE_ML - * - * Another flag for this function: SECOND_TIME (so that float substrs - * with giant delta may be not rechecked). - */ - -/* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend. - Otherwise, only SvCUR(sv) is used to get strbeg. */ -/* XXXX Some places assume that there is a fixed substring. - An update may be needed if optimizer marks as "INTUITable" - RExen without fixed substrings. Similarly, it is assumed that - lengths of all the strings are no more than minlen, thus they - cannot come from lookahead. - (Or minlen should take into account lookahead.) - NOTE: Some of this comment is not correct. minlen does now take account - of lookahead/behind. Further research is required. -- demerphq - -*/ -/* A failure to find a constant substring means that there is no need to make - an expensive call to REx engine, thus we celebrate a failure. Similarly, - finding a substring too deep into the string means that fewer calls to - regtry() should be needed. - - REx compiler's optimizer found 4 possible hints: - a) Anchored substring; - b) Fixed substring; - c) Whether we are anchored (beginning-of-line or \G); - d) First node (of those at offset 0) which may distinguish positions; - We use a)b)d) and multiline-part of c), and try to find a position in the - string which does not contradict any of them. - */ - -/* Most of decisions we do here should have been done at compile time. - The nodes of the REx which we used for the search should have been - deleted from the finite automaton. */ - -/* args: - * rx: the regex to match against - * sv: the SV being matched: only used for utf8 flag; the string - * itself is accessed via the pointers below. Note that on - * something like an overloaded SV, SvPOK(sv) may be false - * and the string pointers may point to something unrelated to - * the SV itself. - * strbeg: real beginning of string - * strpos: the point in the string at which to begin matching - * strend: pointer to the byte following the last char of the string - * flags currently unused; set to 0 - * data: currently unused; set to NULL +/* re_intuit_start(): + * + * Based on some optimiser hints, try to find the earliest position in the + * string where the regex could match. + * + * rx: the regex to match against + * sv: the SV being matched: only used for utf8 flag; the string + * itself is accessed via the pointers below. Note that on + * something like an overloaded SV, SvPOK(sv) may be false + * and the string pointers may point to something unrelated to + * the SV itself. + * strbeg: real beginning of string + * strpos: the point in the string at which to begin matching + * strend: pointer to the byte following the last char of the string + * flags currently unused; set to 0 + * data: currently unused; set to NULL + * + * The basic idea of re_intuit_start() is to use some known information + * about the pattern, namely: + * + * a) the longest known anchored substring (i.e. one that's at a + * constant offset from the beginning of the pattern; but not + * necessarily at a fixed offset from the beginning of the + * string); + * b) the longest floating substring (i.e. one that's not at a constant + * offset from the beginning of the pattern); + * c) Whether the pattern is anchored to the string; either + * an absolute anchor: /^../, or anchored to \n: /^.../m, + * or anchored to pos(): /\G/; + * d) A start class: a real or synthetic character class which + * represents which characters are legal at the start of the pattern; + * + * to either quickly reject the match, or to find the earliest position + * within the string at which the pattern might match, thus avoiding + * running the full NFA engine at those earlier locations, only to + * eventually fail and retry further along. + * + * Returns NULL if the pattern can't match, or returns the address within + * the string which is the earliest place the match could occur. + * + * The longest of the anchored and floating substrings is called 'check' + * and is checked first. The other is called 'other' and is checked + * second. The 'other' substring may not be present. For example, + * + * /(abc|xyz)ABC\d{0,3}DEFG/ + * + * will have + * + * check substr (float) = "DEFG", offset 6..9 chars + * other substr (anchored) = "ABC", offset 3..3 chars + * stclass = [ax] + * + * Be aware that during the course of this function, sometimes 'anchored' + * refers to a substring being anchored relative to the start of the + * pattern, and sometimes to the pattern itself being anchored relative to + * the string. For example: + * + * /\dabc/: "abc" is anchored to the pattern; + * /^\dabc/: "abc" is anchored to the pattern and the string; + * /\d+abc/: "abc" is anchored to neither the pattern nor the string; + * /^\d+abc/: "abc" is anchored to neither the pattern nor the string, + * but the pattern is anchored to the string. */ char * @@ -633,9 +645,8 @@ Perl_re_intuit_start(pTHX_ const U32 flags, re_scream_pos_data *data) { - dVAR; struct regexp *const prog = ReANY(rx); - SSize_t start_shift = 0; + SSize_t start_shift = prog->check_offset_min; /* Should be nonnegative! */ SSize_t end_shift = 0; /* current lowest pos in string where the regex can start matching */ @@ -646,7 +657,6 @@ Perl_re_intuit_start(pTHX_ bool ml_anch = 0; char *other_last = strpos;/* latest pos 'other' substr already checked to */ char *check_at = NULL; /* check substr found at this pos */ - char *checked_upto = NULL; /* how far into the string we have already checked using find_byclass*/ const I32 multiline = prog->extflags & RXf_PMf_MULTILINE; RXi_GET_DECL(prog,progi); regmatch_info reginfo_buf; /* create some info to pass to find_byclass */ @@ -674,7 +684,7 @@ Perl_re_intuit_start(pTHX_ assert(prog->substrs->data[2].max_offset >= 0); /* for now, assume that if both present, that the floating substring - * follows the anchored substring, and that they don't overlap. + * doesn't start before the anchored substring. * If you break this assumption (e.g. doing better optimisations * with lookahead/behind), then you'll need to audit the code in this * function carefully first @@ -684,13 +694,16 @@ Perl_re_intuit_start(pTHX_ && (prog->float_utf8 || prog->float_substr)) || (prog->float_min_offset >= prog->anchored_offset)); - /* CHR_DIST() would be more correct here but it makes things slow. */ + /* byte rather than char calculation for efficiency. It fails + * to quickly reject some cases that can't match, but will reject + * them later after doing full char arithmetic */ if (prog->minlen > strend - strpos) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " String too short...\n")); goto fail; } + RX_MATCH_UTF8_set(rx,utf8_target); reginfo->is_utf8_target = cBOOL(utf8_target); reginfo->info_aux = NULL; reginfo->strbeg = strbeg; @@ -736,21 +749,31 @@ Perl_re_intuit_start(pTHX_ }); if (prog->intflags & PREGf_ANCH) { /* Match at \G, beg-of-str or after \n */ - /* Check after \n? */ - ml_anch = ( (prog->intflags & PREGf_ANCH_MBOL) - || ((prog->intflags & PREGf_ANCH_BOL) && multiline)); - if (!ml_anch) { + /* ml_anch: check after \n? + * + * A note about 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 + * /.*abc/s: PREGf_IMPLICIT | PREGf_ANCH_SBOL + */ + ml_anch = (prog->intflags & PREGf_ANCH_MBOL) + && !(prog->intflags & PREGf_IMPLICIT); + + if (!ml_anch && !(prog->intflags & PREGf_IMPLICIT)) { /* we are only allowed to match at BOS or \G */ /* trivially reject if there's a BOS anchor and we're not at BOS. - * In the case of \G, we hope(!) that the caller has already - * set strpos to pos()-gofs, and will already have checked - * that this anchor position is legal. So we can skip it here. + * + * Note that we don't try to do a similar quick reject for + * \G, since generally the caller will have calculated strpos + * based on pos() and gofs, so the string is already correctly + * anchored by definition; and handling the exceptions would + * be too fiddly (e.g. REXEC_IGNOREPOS). */ - if ( !(prog->intflags & PREGf_ANCH_GPOS) - && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */ - && (strpos != strbeg)) + if ( strpos != strbeg + && (prog->intflags & PREGf_ANCH_SBOL)) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " Not at start...\n")); @@ -759,30 +782,34 @@ Perl_re_intuit_start(pTHX_ /* in the presence of an anchor, the anchored (relative to the * start of the regex) substr must also be anchored relative - * to strpos. So quickly reject if substr isn't found there */ + * to strpos. So quickly reject if substr isn't found there. + * This works for \G too, because the caller will already have + * subtracted gofs from pos, and gofs is the offset from the + * \G to the start of the regex. For example, in /.abc\Gdef/, + * where substr="abcdef", pos()=3, gofs=4, offset_min=1: + * caller will have set strpos=pos()-4; we look for the substr + * at position pos()-4+1, which lines up with the "a" */ if (prog->check_offset_min == prog->check_offset_max - && !(prog->intflags & PREGf_CANY_SEEN) - && ! multiline) /* /m can cause \n's to match that aren't - accounted for in the string max length. - See [perl #115242] */ + && !(prog->intflags & PREGf_CANY_SEEN)) { /* Substring at constant offset from beg-of-str... */ SSize_t slen = SvCUR(check); - char *s; - - s = HOP3c(strpos, prog->check_offset_min, strend); + char *s = HOP3c(strpos, prog->check_offset_min, strend); DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " Looking for check substr at fixed offset %"IVdf"...\n", (IV)prog->check_offset_min)); if (SvTAIL(check)) { - /* In this case, the regex is anchored at the end too, - * so the lengths must match exactly, give or take a \n. - * NB: slen >= 1 since the last char of check is \n */ - if ( strend - s > slen || strend - s < slen - 1 - || (strend - s == slen && strend[-1] != '\n')) + /* In this case, the regex is anchored at the end too. + * Unless it's a multiline match, the lengths must match + * exactly, give or take a \n. NB: slen >= 1 since + * the last char of check is \n */ + if (!multiline + && ( strend - s > slen + || strend - s < slen - 1 + || (strend - s == slen && strend[-1] != '\n'))) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " String too long...\n")); @@ -805,7 +832,6 @@ Perl_re_intuit_start(pTHX_ } } - start_shift = prog->check_offset_min; /* okay to underestimate on CC */ end_shift = prog->check_end_shift; #ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */ @@ -815,11 +841,32 @@ Perl_re_intuit_start(pTHX_ #endif restart: - /* Find a candidate regex origin in the region rx_origin..strend - * by looking for the "check" substring in that region, corrected by - * start/end_shift. - */ + /* This is the (re)entry point of the main loop in this function. + * The goal of this loop is to: + * 1) find the "check" substring in the region rx_origin..strend + * (adjusted by start_shift / end_shift). If not found, reject + * immediately. + * 2) If it exists, look for the "other" substr too if defined; for + * example, if the check substr maps to the anchored substr, then + * check the floating substr, and vice-versa. If not found, go + * back to (1) with rx_origin suitably incremented. + * 3) If we find an rx_origin position that doesn't contradict + * either of the substrings, then check the possible additional + * constraints on rx_origin of /^.../m or a known start class. + * If these fail, then depending on which constraints fail, jump + * back to here, or to various other re-entry points further along + * that skip some of the first steps. + * 4) If we pass all those tests, update the BmUSEFUL() count on the + * substring. If the start position was determined to be at the + * beginning of the string - so, not rejected, but not optimised, + * since we have to run regmatch from position 0 - decrement the + * BmUSEFUL() count. Otherwise increment it. + */ + + + /* first, look for the 'check' substring */ + { U8* start_point; U8* end_point; @@ -839,24 +886,42 @@ Perl_re_intuit_start(pTHX_ if (prog->intflags & PREGf_CANY_SEEN) { start_point= (U8*)(rx_origin + start_shift); end_point= (U8*)(strend - end_shift); + if (start_point > end_point) + goto fail_finish; } else { - start_point= HOP3(rx_origin, start_shift, strend); - end_point= HOP3(strend, -end_shift, strbeg); + end_point = HOP3(strend, -end_shift, strbeg); + start_point = HOPMAYBE3(rx_origin, start_shift, end_point); + if (!start_point) + goto fail_finish; } - /* if the regex is absolutely anchored to the start of the string, - * then check_offset_max represents an upper bound on the string - * where the substr could start */ + + /* If the regex is absolutely anchored to either the start of the + * 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 + * pos()-gofs, so in this case strpos + offset_max will still be + * an upper bound on the substr. + */ if (!ml_anch && prog->intflags & PREGf_ANCH - && prog->check_offset_max != SSize_t_MAX - && start_shift < prog->check_offset_max) + && prog->check_offset_max != SSize_t_MAX) { SSize_t len = SvCUR(check) - !!SvTAIL(check); - end_point = HOP3lim(start_point, - prog->check_offset_max - start_shift, - end_point -len) - + len; + const char * const anchor = + (prog->intflags & PREGf_ANCH_GPOS ? strpos : strbeg); + + /* do a bytes rather than chars comparison. It's conservative; + * so it skips doing the HOP if the result can't possibly end + * up earlier than the old value of end_point. + */ + if ((char*)end_point - anchor > prog->check_offset_max) { + end_point = HOP3lim((U8*)anchor, + prog->check_offset_max, + end_point -len) + + len; + } } DEBUG_OPTIMISE_MORE_r({ @@ -868,50 +933,38 @@ Perl_re_intuit_start(pTHX_ check_at = fbm_instr( start_point, end_point, check, multiline ? FBMrf_MULTILINE : 0); - } - /* Update the count-of-usability, remove useless subpatterns, - unshift s. */ - - DEBUG_EXECUTE_r({ - RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0), - SvPVX_const(check), RE_SV_DUMPLEN(check), 30); - PerlIO_printf(Perl_debug_log, " %s %s substr %s%s%s", - (check_at ? "Found" : "Did not find"), - (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr) - ? "anchored" : "floating"), - quoted, - RE_SV_TAIL(check), - (check_at ? " at offset " : "...\n") ); - }); + /* Update the count-of-usability, remove useless subpatterns, + unshift s. */ - if (!check_at) - goto fail_finish; - /* Finish the diagnostic message */ - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(check_at - strpos)) ); + DEBUG_EXECUTE_r({ + RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0), + SvPVX_const(check), RE_SV_DUMPLEN(check), 30); + PerlIO_printf(Perl_debug_log, " %s %s substr %s%s%s", + (check_at ? "Found" : "Did not find"), + (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr) + ? "anchored" : "floating"), + quoted, + RE_SV_TAIL(check), + (check_at ? " at offset " : "...\n") ); + }); - /* set rx_origin to the minimum position where the regex could start - * matching, given the constraint of the just-matched check substring. - * But don't set it lower than previously. - */ + if (!check_at) + goto fail_finish; + /* Finish the diagnostic message */ + DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(check_at - strpos)) ); - if (check_at - rx_origin > prog->check_offset_max) - rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin); + /* set rx_origin to the minimum position where the regex could start + * matching, given the constraint of the just-matched check substring. + * But don't set it lower than previously. + */ + if (check_at - rx_origin > prog->check_offset_max) + rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin); + } - /* XXX dmq: first branch is for positive lookbehind... - Our check string is offset from the beginning of the pattern. - So we need to do any stclass tests offset forward from that - point. I think. :-( - */ - - /* Got a candidate. Check MBOL anchoring, and the *other* substr. - Start with the other substr. - XXXX no SCREAM optimization yet - and a very coarse implementation - XXXX /ttx+/ results in anchored="ttx", floating="x". floating will - *always* match. Probably should be marked during compile... - Probably it is right to do no SCREAM here... - */ + + /* now look for the 'other' substring if defined */ if (utf8_target ? prog->substrs->data[other_ix].utf8_substr : prog->substrs->data[other_ix].substr) @@ -1090,12 +1143,9 @@ Perl_re_intuit_start(pTHX_ postprocess_substr_matches: - /* handle the extra constraint of /^/m */ + /* handle the extra constraint of /^.../m if present */ - if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n' - /* May be due to an implicit anchor of m{.*foo} */ - && !(prog->intflags & PREGf_IMPLICIT)) - { + if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n') { char *s; DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, @@ -1167,74 +1217,17 @@ Perl_re_intuit_start(pTHX_ } else { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, - " Starting position does not contradict /%s^%s/m...\n", - PL_colors[0], PL_colors[1])); + " (multiline anchor test skipped)\n")); } + success_at_start: - /* Decide whether using the substrings helped */ - if (rx_origin != strpos) { - /* Fixed substring is found far enough so that the match - cannot start at strpos. */ - - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " try at offset...\n")); - ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr); /* hooray/5 */ - } - else { - /* The found string does not prohibit matching at strpos, - - no optimization of calling REx engine can be performed, - unless it was an MBOL and we are not after MBOL, - or a future STCLASS check will fail this. */ - success_at_start: - if (!(prog->intflags & PREGf_NAUGHTY) /* XXXX If strpos moved? */ - && (utf8_target ? ( - prog->check_utf8 /* Could be deleted already */ - && --BmUSEFUL(prog->check_utf8) < 0 - && (prog->check_utf8 == prog->float_utf8) - ) : ( - prog->check_substr /* Could be deleted already */ - && --BmUSEFUL(prog->check_substr) < 0 - && (prog->check_substr == prog->float_substr) - ))) - { - /* If flags & SOMETHING - do not do it many times on the same match */ - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " ... Disabling check substring...\n")); - /* XXX Does the destruction order has to change with utf8_target? */ - SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr); - SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8); - prog->check_substr = prog->check_utf8 = NULL; /* disable */ - prog->float_substr = prog->float_utf8 = NULL; /* clear */ - check = NULL; /* abort */ - /* XXXX If the check string was an implicit check MBOL, then we need to unset the relevant flag - see http://bugs.activestate.com/show_bug.cgi?id=87173 */ - if (prog->intflags & PREGf_IMPLICIT) { - prog->intflags &= ~PREGf_ANCH_MBOL; - /* maybe we have no anchors left after this... */ - if (!(prog->intflags & PREGf_ANCH)) - prog->extflags &= ~RXf_IS_ANCHORED; - } - /* XXXX This is a remnant of the old implementation. It - looks wasteful, since now INTUIT can use many - other heuristics. */ - prog->extflags &= ~RXf_USE_INTUIT; - /* XXXX What other flags might need to be cleared in this branch? */ - } - } + /* if we have a starting character class, then test that extra constraint. + * (trie stclasses are too expensive to use here, we are better off to + * leave it to regmatch itself) */ - /* Last resort... */ - /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */ - /* trie stclasses are too expensive to use here, we are better off to - leave it to regmatch itself */ if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) { - /* minlen == 0 is possible if regstclass is \b or \B, - and the fixed substr is ''$. - Since minlen is already taken into account, rx_origin+1 is before strend; - accidentally, minlen >= 1 guaranties no false positives at rx_origin + 1 - 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-ish only, which are dealt with in find_byclass(). */ const U8* const str = (U8*)STRING(progi->regstclass); /* XXX this value could be pre-computed */ @@ -1245,27 +1238,51 @@ Perl_re_intuit_start(pTHX_ : 1); char * endpos; char *s; + /* latest pos that a matching float substr constrains rx start to */ + char *rx_max_float = NULL; + + /* if the current rx_origin is anchored, either by satisfying an + * anchored substring constraint, or a /^.../m constraint, then we + * can reject the current origin if the start class isn't found + * at the current position. If we have a float-only match, then + * rx_origin is constrained to a range; so look for the start class + * in that range. if neither, then look for the start class in the + * whole rest of the string */ + + /* XXX DAPM it's not clear what the minlen test is for, and why + * it's not used in the floating case. Nothing in the test suite + * causes minlen == 0 here. See <20140313134639.GS12844@iabyn.com>. + * Here are some old comments, which may or may not be correct: + * + * minlen == 0 is possible if regstclass is \b or \B, + * and the fixed substr is ''$. + * Since minlen is already taken into account, rx_origin+1 is + * before strend; accidentally, minlen >= 1 guaranties no false + * positives at rx_origin + 1 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-ish only, which are dealt with in + * find_byclass(). + */ + if (prog->anchored_substr || prog->anchored_utf8 || ml_anch) endpos= HOP3c(rx_origin, (prog->minlen ? cl_l : 0), strend); - else if (prog->float_substr || prog->float_utf8) - endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend); + else if (prog->float_substr || prog->float_utf8) { + rx_max_float = HOP3c(check_at, -start_shift, strbeg); + endpos= HOP3c(rx_max_float, cl_l, strend); + } else endpos= strend; - if (checked_upto < rx_origin) - checked_upto = rx_origin; DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " looking for class: start_shift: %"IVdf" check_at: %"IVdf - " rx_origin: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n", + " rx_origin: %"IVdf" endpos: %"IVdf"\n", (IV)start_shift, (IV)(check_at - strbeg), - (IV)(rx_origin - strbeg), (IV)(endpos - strbeg), - (IV)(checked_upto- strbeg))); + (IV)(rx_origin - strbeg), (IV)(endpos - strbeg))); - s = find_byclass(prog, progi->regstclass, checked_upto, endpos, + s = find_byclass(prog, progi->regstclass, rx_origin, endpos, reginfo); - if (s) { - checked_upto = s; - } else { + if (!s) { if (endpos == strend) { DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " Could not match STCLASS...\n") ); @@ -1273,11 +1290,9 @@ Perl_re_intuit_start(pTHX_ } DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " This position contradicts STCLASS...\n") ); - if ((prog->intflags & PREGf_ANCH) && !ml_anch) + if ((prog->intflags & PREGf_ANCH) && !ml_anch + && !(prog->intflags & PREGf_IMPLICIT)) goto fail; - checked_upto = HOPBACKc(endpos, start_shift); - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " start_shift: %"IVdf" check_at: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n", - (IV)start_shift, (IV)(check_at - strbeg), (IV)(endpos - strbeg), (IV)(checked_upto- strbeg))); /* Contradict one of substrings */ if (prog->anchored_substr || prog->anchored_utf8) { @@ -1286,11 +1301,12 @@ Perl_re_intuit_start(pTHX_ assert(rx_origin + start_shift <= check_at); if (rx_origin + start_shift != check_at) { /* not at latest position float substr could match: - * Recheck anchored substring, but not floating... */ - if (!check) { - rx_origin = NULL; - goto giveup; - } + * Recheck anchored substring, but not floating. + * The condition above is in bytes rather than + * chars for efficiency. It's conservative, in + * that it errs on the side of doing 'goto + * do_other_substr', where a more accurate + * char-based calculation will be done */ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " Looking for anchored substr starting at offset %ld...\n", (long)(other_last - strpos)) ); @@ -1301,30 +1317,39 @@ Perl_re_intuit_start(pTHX_ else { /* float-only */ - /* Another way we could have checked stclass at the - current position only: */ if (ml_anch) { + /* In the presence of ml_anch, we might be able to + * find another \n without breaking the current float + * constraint. */ + + /* strictly speaking this should be HOP3c(..., 1, ...), + * but since we goto a block of code that's going to + * search for the next \n if any, its safe here */ rx_origin++; - if (!check) - goto giveup; DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " Looking for /%s^%s/m starting at offset %ld...\n", PL_colors[0], PL_colors[1], (long)(rx_origin - strpos)) ); - /* XXX DAPM I don't yet know why this is true, but the code - * assumed it when it used to do goto try_at_offset */ - assert(rx_origin != strpos); goto postprocess_substr_matches; } - if (!(utf8_target ? prog->float_utf8 : prog->float_substr)) /* Could have been deleted */ + + /* strictly speaking this can never be true; but might + * be if we ever allow intuit without substrings */ + if (!(utf8_target ? prog->float_utf8 : prog->float_substr)) goto fail; - /* Check is floating substring. */ - rx_origin = check_at - start_shift; + + rx_origin = rx_max_float; } + /* at this point, any matching substrings have been + * contradicted. Start again... */ + rx_origin = HOP3c(rx_origin, 1, strend); + + /* uses bytes rather than char calculations for efficiency. + * It's conservative: it errs on the side of doing 'goto restart', + * where there is code that does a proper char-based test */ if (rx_origin + start_shift + end_shift > strend) { - /* XXXX Should be taken into account earlier? */ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " Could not match STCLASS...\n") ); goto fail; @@ -1336,6 +1361,8 @@ Perl_re_intuit_start(pTHX_ goto restart; } + /* Success !!! */ + if (rx_origin != s) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " By STCLASS: moving %ld --> %ld\n", @@ -1348,10 +1375,51 @@ Perl_re_intuit_start(pTHX_ ); } } - giveup: - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Intuit: %s%s:%s match at offset %ld\n", - PL_colors[4], (check ? "Successfully guessed" : "Giving up"), - PL_colors[5], (long)(rx_origin - strpos)) ); + + /* Decide whether using the substrings helped */ + + if (rx_origin != strpos) { + /* Fixed substring is found far enough so that the match + cannot start at strpos. */ + + DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " try at offset...\n")); + ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr); /* hooray/5 */ + } + else { + /* The found rx_origin position does not prohibit matching at + * strpos, so calling intuit didn't gain us anything. Decrement + * the BmUSEFUL() count on the check substring, and if we reach + * zero, free it. */ + if (!(prog->intflags & PREGf_NAUGHTY) + && (utf8_target ? ( + prog->check_utf8 /* Could be deleted already */ + && --BmUSEFUL(prog->check_utf8) < 0 + && (prog->check_utf8 == prog->float_utf8) + ) : ( + prog->check_substr /* Could be deleted already */ + && --BmUSEFUL(prog->check_substr) < 0 + && (prog->check_substr == prog->float_substr) + ))) + { + /* If flags & SOMETHING - do not do it many times on the same match */ + DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " ... Disabling check substring...\n")); + /* XXX Does the destruction order has to change with utf8_target? */ + SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr); + SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8); + prog->check_substr = prog->check_utf8 = NULL; /* disable */ + prog->float_substr = prog->float_utf8 = NULL; /* clear */ + check = NULL; /* abort */ + /* XXXX This is a remnant of the old implementation. It + looks wasteful, since now INTUIT can use many + other heuristics. */ + prog->extflags &= ~RXf_USE_INTUIT; + } + } + + DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, + "Intuit: %sSuccessfully guessed:%s match at offset %ld\n", + PL_colors[4], PL_colors[5], (long)(rx_origin - strpos)) ); + return rx_origin; fail_finish: /* Substring not found */ @@ -1363,6 +1431,7 @@ Perl_re_intuit_start(pTHX_ return NULL; } + #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 } \ @@ -1379,7 +1448,7 @@ STMT_START { switch (trie_type) { \ case trie_utf8_exactfa_fold: \ flags |= FOLD_FLAGS_NOMIX_ASCII; \ - /* FALL THROUGH */ \ + /* FALLTHROUGH */ \ case trie_utf8_fold: \ if ( foldlen>0 ) { \ uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \ @@ -1396,7 +1465,7 @@ STMT_START { break; \ case trie_latin_utf8_exactfa_fold: \ flags |= FOLD_FLAGS_NOMIX_ASCII; \ - /* FALL THROUGH */ \ + /* FALLTHROUGH */ \ case trie_latin_utf8_fold: \ if ( foldlen>0 ) { \ uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \ @@ -1432,10 +1501,14 @@ STMT_START { } \ } STMT_END -#define REXEC_FBC_EXACTISH_SCAN(CoNd) \ +#define DUMP_EXEC_POS(li,s,doutf8) \ + dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \ + startpos, doutf8) + +#define REXEC_FBC_EXACTISH_SCAN(COND) \ STMT_START { \ while (s <= e) { \ - if ( (CoNd) \ + if ( (COND) \ && (ln == 1 || folder(s, pat_string, ln)) \ && (reginfo->intuit || regtry(reginfo, &s)) )\ goto got_it; \ @@ -1443,148 +1516,199 @@ STMT_START { \ } \ } STMT_END -#define REXEC_FBC_UTF8_SCAN(CoDe) \ +#define REXEC_FBC_UTF8_SCAN(CODE) \ STMT_START { \ while (s < strend) { \ - CoDe \ + CODE \ s += UTF8SKIP(s); \ } \ } STMT_END -#define REXEC_FBC_SCAN(CoDe) \ +#define REXEC_FBC_SCAN(CODE) \ STMT_START { \ while (s < strend) { \ - CoDe \ + CODE \ s++; \ } \ } STMT_END -#define REXEC_FBC_UTF8_CLASS_SCAN(CoNd) \ -REXEC_FBC_UTF8_SCAN( \ - if (CoNd) { \ - if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \ - goto got_it; \ - else \ - tmp = doevery; \ - } \ - else \ - tmp = 1; \ +#define REXEC_FBC_UTF8_CLASS_SCAN(COND) \ +REXEC_FBC_UTF8_SCAN( /* Loops while (s < strend) */ \ + if (COND) { \ + if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \ + goto got_it; \ + else \ + tmp = doevery; \ + } \ + else \ + tmp = 1; \ ) -#define REXEC_FBC_CLASS_SCAN(CoNd) \ -REXEC_FBC_SCAN( \ - if (CoNd) { \ - if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \ - goto got_it; \ - else \ - tmp = doevery; \ - } \ - else \ - tmp = 1; \ +#define REXEC_FBC_CLASS_SCAN(COND) \ +REXEC_FBC_SCAN( /* Loops while (s < strend) */ \ + if (COND) { \ + if (tmp && (reginfo->intuit || regtry(reginfo, &s))) \ + goto got_it; \ + else \ + tmp = doevery; \ + } \ + else \ + tmp = 1; \ ) -#define REXEC_FBC_TRYIT \ -if ((reginfo->intuit || regtry(reginfo, &s))) \ - goto got_it - -#define REXEC_FBC_CSCAN(CoNdUtF8,CoNd) \ +#define REXEC_FBC_CSCAN(CONDUTF8,COND) \ if (utf8_target) { \ - REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \ + REXEC_FBC_UTF8_CLASS_SCAN(CONDUTF8); \ } \ else { \ - REXEC_FBC_CLASS_SCAN(CoNd); \ + REXEC_FBC_CLASS_SCAN(COND); \ } - -#define DUMP_EXEC_POS(li,s,doutf8) \ - dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \ - startpos, doutf8) - -#define UTF8_NOLOAD(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \ - tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \ - tmp = TEST_NON_UTF8(tmp); \ - REXEC_FBC_UTF8_SCAN( \ - if (tmp == ! TEST_NON_UTF8((U8) *s)) { \ - tmp = !tmp; \ - IF_SUCCESS; \ - } \ - else { \ - IF_FAIL; \ - } \ - ); \ - -#define UTF8_LOAD(TeSt1_UtF8, TeSt2_UtF8, IF_SUCCESS, IF_FAIL) \ - if (s == reginfo->strbeg) { \ - tmp = '\n'; \ - } \ - else { \ - U8 * const r = reghop3((U8*)s, -1, (U8*)reginfo->strbeg); \ - tmp = utf8n_to_uvchr(r, (U8*) reginfo->strend - r, \ +/* The three macros below are slightly different versions of the same logic. + * + * The first is for /a and /aa when the target string is UTF-8. This can only + * match ascii, but it must advance based on UTF-8. The other two handle the + * non-UTF-8 and the more generic UTF-8 cases. In all three, we are looking + * for the boundary (or non-boundary) between a word and non-word character. + * The utf8 and non-utf8 cases have the same logic, but the details must be + * different. Find the "wordness" of the character just prior to this one, and + * compare it with the wordness of this one. If they differ, we have a + * boundary. At the beginning of the string, pretend that the previous + * character was a new-line. + * + * All these macros uncleanly have side-effects with each other and outside + * variables. So far it's been too much trouble to clean-up + * + * TEST_NON_UTF8 is the macro or function to call to test if its byte input is + * a word character or not. + * IF_SUCCESS is code to do if it finds that we are at a boundary between + * word/non-word + * IF_FAIL is code to do if we aren't at a boundary between word/non-word + * + * Exactly one of the two IF_FOO parameters is a no-op, depending on whether we + * are looking for a boundary or for a non-boundary. If we are looking for a + * boundary, we want IF_FAIL to be the no-op, and for IF_SUCCESS to go out and + * see if this tentative match actually works, and if so, to quit the loop + * here. And vice-versa if we are looking for a non-boundary. + * + * 'tmp' below in the next three macros in the REXEC_FBC_SCAN and + * REXEC_FBC_UTF8_SCAN loops is a loop invariant, a bool giving the return of + * TEST_NON_UTF8(s-1). To see this, note that that's what it is defined to be + * at entry to the loop, and to get to the IF_FAIL branch, tmp must equal + * TEST_NON_UTF8(s), and in the opposite branch, IF_SUCCESS, tmp is that + * complement. But in that branch we complement tmp, meaning that at the + * bottom of the loop tmp is always going to be equal to TEST_NON_UTF8(s), + * which means at the top of the loop in the next iteration, it is + * TEST_NON_UTF8(s-1) */ +#define FBC_UTF8_A(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \ + tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \ + tmp = TEST_NON_UTF8(tmp); \ + REXEC_FBC_UTF8_SCAN( /* advances s while s < strend */ \ + if (tmp == ! TEST_NON_UTF8((U8) *s)) { \ + tmp = !tmp; \ + IF_SUCCESS; /* Is a boundary if values for s-1 and s differ */ \ + } \ + else { \ + IF_FAIL; \ + } \ + ); \ + +/* Like FBC_UTF8_A, but TEST_UV is a macro which takes a UV as its input, and + * TEST_UTF8 is a macro that for the same input code points returns identically + * to TEST_UV, but takes a pointer to a UTF-8 encoded string instead */ +#define FBC_UTF8(TEST_UV, TEST_UTF8, IF_SUCCESS, IF_FAIL) \ + if (s == reginfo->strbeg) { \ + tmp = '\n'; \ + } \ + else { /* Back-up to the start of the previous character */ \ + U8 * const r = reghop3((U8*)s, -1, (U8*)reginfo->strbeg); \ + tmp = utf8n_to_uvchr(r, (U8*) reginfo->strend - r, \ 0, UTF8_ALLOW_DEFAULT); \ - } \ - tmp = TeSt1_UtF8; \ - LOAD_UTF8_CHARCLASS_ALNUM(); \ - REXEC_FBC_UTF8_SCAN( \ - if (tmp == ! (TeSt2_UtF8)) { \ - tmp = !tmp; \ - IF_SUCCESS; \ - } \ - else { \ - IF_FAIL; \ - } \ - ); \ + } \ + tmp = TEST_UV(tmp); \ + LOAD_UTF8_CHARCLASS_ALNUM(); \ + REXEC_FBC_UTF8_SCAN( /* advances s while s < strend */ \ + if (tmp == ! (TEST_UTF8((U8 *) s))) { \ + tmp = !tmp; \ + IF_SUCCESS; \ + } \ + else { \ + IF_FAIL; \ + } \ + ); -/* The only difference between the BOUND and NBOUND cases is that - * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in - * NBOUND. This is accomplished by passing it in either the if or else clause, - * with the other one being empty */ -#define FBC_BOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \ - FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER) - -#define FBC_BOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \ - FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER) - -#define FBC_NBOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \ - FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT) - -#define FBC_NBOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \ - FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT) - - -/* Common to the BOUND and NBOUND cases. Unfortunately the UTF8 tests need to - * be passed in completely with the variable name being tested, which isn't - * such a clean interface, but this is easier to read than it was before. We - * are looking for the boundary (or non-boundary between a word and non-word - * character. The utf8 and non-utf8 cases have the same logic, but the details - * must be different. Find the "wordness" of the character just prior to this - * one, and compare it with the wordness of this one. If they differ, we have - * a boundary. At the beginning of the string, pretend that the previous - * character was a new-line */ +/* Like the above two macros. UTF8_CODE is the complete code for handling + * UTF-8. Common to the BOUND and NBOUND cases, set-up by the FBC_BOUND, etc + * macros below */ #define FBC_BOUND_COMMON(UTF8_CODE, TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \ if (utf8_target) { \ - UTF8_CODE \ + UTF8_CODE \ } \ else { /* Not utf8 */ \ tmp = (s != reginfo->strbeg) ? UCHARAT(s - 1) : '\n'; \ tmp = TEST_NON_UTF8(tmp); \ - REXEC_FBC_SCAN( \ + REXEC_FBC_SCAN( /* advances s while s < strend */ \ if (tmp == ! TEST_NON_UTF8((U8) *s)) { \ - tmp = !tmp; \ IF_SUCCESS; \ + tmp = !tmp; \ } \ else { \ IF_FAIL; \ } \ ); \ } \ - if ((!prog->minlen && tmp) && (reginfo->intuit || regtry(reginfo, &s))) \ - goto got_it; + /* Here, things have been set up by the previous code so that tmp is the \ + * return of TEST_NON_UTF(s-1) or TEST_UTF8(s-1) (depending on the \ + * utf8ness of the target). We also have to check if this matches against \ + * the EOS, which we treat as a \n (which is the same value in both UTF-8 \ + * or non-UTF8, so can use the non-utf8 test condition even for a UTF-8 \ + * string */ \ + if (tmp == ! TEST_NON_UTF8('\n')) { \ + IF_SUCCESS; \ + } \ + else { \ + IF_FAIL; \ + } + +/* This is the macro to use when we want to see if something that looks like it + * could match, actually does, and if so exits the loop */ +#define REXEC_FBC_TRYIT \ + if ((reginfo->intuit || regtry(reginfo, &s))) \ + goto got_it + +/* The only difference between the BOUND and NBOUND cases is that + * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in + * NBOUND. This is accomplished by passing it as either the if or else clause, + * with the other one being empty (PLACEHOLDER is defined as empty). + * + * The TEST_FOO parameters are for operating on different forms of input, but + * all should be ones that return identically for the same underlying code + * points */ +#define FBC_BOUND(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \ + FBC_BOUND_COMMON( \ + 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) \ + FBC_BOUND_COMMON( \ + FBC_UTF8_A(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), \ + TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER) + +#define FBC_NBOUND(TEST_NON_UTF8, TEST_UV, TEST_UTF8) \ + FBC_BOUND_COMMON( \ + 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) \ + FBC_BOUND_COMMON( \ + FBC_UTF8_A(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), \ + TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT) + /* We know what class REx starts with. Try to find this position... */ /* if reginfo->intuit, its a dryrun */ /* annoyingly all the vars in this routine have different names from their counterparts in regmatch. /grrr */ - STATIC char * S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char *strend, regmatch_info *reginfo) @@ -1635,7 +1759,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */ assert(! is_utf8_pat); - /* FALL THROUGH */ + /* FALLTHROUGH */ case EXACTFA: if (is_utf8_pat || utf8_target) { utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII; @@ -1682,7 +1806,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, fold_array = PL_fold_latin1; folder = foldEQ_latin1; - /* FALL THROUGH */ + /* FALLTHROUGH */ do_exactf_non_utf8: /* Neither pattern nor string are UTF8, and there are no glitches with fold-length differences @@ -1773,45 +1897,30 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, } break; } + case BOUNDL: - FBC_BOUND(isWORDCHAR_LC, - isWORDCHAR_LC_uvchr(tmp), - isWORDCHAR_LC_utf8((U8*)s)); + FBC_BOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8); break; case NBOUNDL: - FBC_NBOUND(isWORDCHAR_LC, - isWORDCHAR_LC_uvchr(tmp), - isWORDCHAR_LC_utf8((U8*)s)); + FBC_NBOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8); break; case BOUND: - FBC_BOUND(isWORDCHAR, - isWORDCHAR_uni(tmp), - cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target))); + FBC_BOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8); break; case BOUNDA: - FBC_BOUND_NOLOAD(isWORDCHAR_A, - isWORDCHAR_A(tmp), - isWORDCHAR_A((U8*)s)); + FBC_BOUND_A(isWORDCHAR_A, isWORDCHAR_A, isWORDCHAR_A); break; case NBOUND: - FBC_NBOUND(isWORDCHAR, - isWORDCHAR_uni(tmp), - cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target))); + FBC_NBOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8); break; case NBOUNDA: - FBC_NBOUND_NOLOAD(isWORDCHAR_A, - isWORDCHAR_A(tmp), - isWORDCHAR_A((U8*)s)); + FBC_NBOUND_A(isWORDCHAR_A, isWORDCHAR_A, isWORDCHAR_A); break; case BOUNDU: - FBC_BOUND(isWORDCHAR_L1, - isWORDCHAR_uni(tmp), - cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target))); + FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); break; case NBOUNDU: - FBC_NBOUND(isWORDCHAR_L1, - isWORDCHAR_uni(tmp), - cBOOL(swash_fetch(PL_utf8_swash_ptrs[_CC_WORDCHAR], (U8*)s, utf8_target))); + FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); break; case LNBREAK: REXEC_FBC_CSCAN(is_LNBREAK_utf8_safe(s, strend), @@ -1844,9 +1953,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, case NPOSIXA: if (utf8_target) { /* The complement of something that matches only ASCII matches all - * UTF-8 variant code points, plus everything in ASCII that isn't - * in the class */ - REXEC_FBC_UTF8_CLASS_SCAN(! UTF8_IS_INVARIANT(*s) + * non-ASCII, plus everything in ASCII that isn't in the class. */ + REXEC_FBC_UTF8_CLASS_SCAN(! isASCII_utf8(s) || ! _generic_isCC_A(*s, FLAGS(c))); break; } @@ -1910,7 +2018,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, macros */ case _CC_ENUM_SPACE: /* XXX would require separate code if we revert the change of \v matching this */ - /* FALL THROUGH */ + /* FALLTHROUGH */ case _CC_ENUM_PSXSPC: REXEC_FBC_UTF8_CLASS_SCAN( @@ -2187,7 +2295,6 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, break; default: Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c)); - break; } return 0; got_it: @@ -2362,7 +2469,6 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, /* flags: For optimizations. See REXEC_* in regexp.h */ { - dVAR; struct regexp *const prog = ReANY(rx); char *s; regnode *c; @@ -2384,7 +2490,6 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, /* Be paranoid... */ if (prog == NULL || stringarg == NULL) { Perl_croak(aTHX_ "NULL regexp parameter"); - return 0; } DEBUG_EXECUTE_r( @@ -2512,6 +2617,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, Perl_croak(aTHX_ "corrupted regexp program"); } + RX_MATCH_TAINTED_off(rx); + RX_MATCH_UTF8_set(rx, utf8_target); + reginfo->prog = rx; /* Yes, sorry that this is confusing. */ reginfo->intuit = 0; reginfo->is_utf8_target = cBOOL(utf8_target); @@ -2531,7 +2639,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); @@ -2609,7 +2716,7 @@ 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] */ + /* [unless only anchor is MBOL - implying multiline is set] */ if (prog->intflags & (PREGf_ANCH & ~PREGf_ANCH_GPOS)) { if (s == startpos && regtry(reginfo, &s)) goto got_it; @@ -2863,7 +2970,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); @@ -2969,7 +3076,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; } @@ -3031,8 +3139,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, @@ -3082,7 +3188,6 @@ phooey: STATIC I32 /* 0 failure, 1 success */ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp) { - dVAR; CHECKPOINT lastcp; REGEXP *const rx = reginfo->prog; regexp *const prog = ReANY(rx); @@ -3453,7 +3558,7 @@ S_dump_exec_pos(pTHX_ const char *locinput, * or 0 if non of the buffers matched. */ STATIC I32 -S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) +S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan) { I32 n; RXi_GET_DECL(rex,rexi); @@ -3529,8 +3634,8 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, const bool utf8_target = reginfo->is_utf8_target; - UV c1 = CHRTEST_NOT_A_CP_1; - UV c2 = CHRTEST_NOT_A_CP_2; + UV c1 = (UV)CHRTEST_NOT_A_CP_1; + UV c2 = (UV)CHRTEST_NOT_A_CP_2; bool use_chrtest_void = FALSE; const bool is_utf8_pat = reginfo->is_utf8_pat; @@ -3621,18 +3726,11 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, } else { /* an EXACTFish node which doesn't begin with a multi-char fold */ c1 = is_utf8_pat ? valid_utf8_to_uvchr(pat, NULL) : *pat; - if (c1 > 256) { + if (c1 > 255) { /* Load the folds hash, if not already done */ SV** listp; if (! PL_utf8_foldclosures) { - if (! PL_utf8_tofold) { - U8 dummy[UTF8_MAXBYTES_CASE+1]; - - /* Force loading this by folding an above-Latin1 char */ - to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL); - assert(PL_utf8_tofold); /* Verify that worked */ - } - PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold); + _load_PL_utf8_foldclosures(); } /* The fold closures data structure is a hash with the keys @@ -3674,10 +3772,10 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, /* Folds that cross the 255/256 boundary are forbidden * if EXACTFL (and isnt a UTF8 locale), or EXACTFA and * one is ASCIII. Since the pattern character is above - * 256, and its only other match is below 256, the only + * 255, and its only other match is below 256, the only * legal match will be to itself. We have thrown away * the original, so have to compute which is the one - * above 255 */ + * above 255. */ if ((c1 < 256) != (c2 < 256)) { if ((OP(text_node) == EXACTFL && ! IN_UTF8_CTYPE_LOCALE) @@ -3696,7 +3794,7 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, } } } - else /* Here, c1 is < 255 */ + else /* Here, c1 is <= 255 */ if (utf8_target && HAS_NONLATIN1_FOLD_CLOSURE(c1) && ( ! (OP(text_node) == EXACTFL && ! IN_UTF8_CTYPE_LOCALE)) @@ -3737,7 +3835,7 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */ assert(! is_utf8_pat); - /* FALL THROUGH */ + /* FALLTHROUGH */ case EXACTFA: case EXACTFU_SS: case EXACTFU: @@ -3893,7 +3991,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) 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", @@ -3915,8 +4013,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; @@ -3939,21 +4036,22 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) st->u.keeper.val = rex->offs[0].start; rex->offs[0].start = locinput - reginfo->strbeg; PUSH_STATE_GOTO(KEEPS_next, next, locinput); - assert(0); /*NOTREACHED*/ + /* NOTREACHED */ + assert(0); + case KEEPS_next_fail: /* rollback the start point change */ rex->offs[0].start = st->u.keeper.val; sayNO_SILENT; - assert(0); /*NOTREACHED*/ + /* NOTREACHED */ + assert(0); case MEOL: /* /..$/m */ if (!NEXTCHR_IS_EOS && nextchr != '\n') sayNO; break; - case EOL: /* /..$/ */ - /* FALL THROUGH */ - case SEOL: /* /..$/s */ + case SEOL: /* /..$/ */ if (!NEXTCHR_IS_EOS && nextchr != '\n') sayNO; if (reginfo->strend - locinput > 1) @@ -3995,9 +4093,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]) ); sayNO_SILENT; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } - /* FALL THROUGH */ + /* FALLTHROUGH */ case TRIE: /* (ab|cd) */ /* the basic plan of execution of the trie is: * At the beginning, run though all the states, and @@ -4182,7 +4281,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) ); goto trie_first_try; /* jump into the fail handler */ }} - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case TRIE_next_fail: /* we failed - try next alternative */ { @@ -4296,7 +4396,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (ST.accepted > 1 || has_cutgroup) { PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } /* only one choice left - just continue */ DEBUG_EXECUTE_r({ @@ -4320,7 +4421,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) locinput = (char*)uc; continue; /* execute rest of RE */ - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } #undef ST @@ -4425,7 +4527,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */ assert(! is_utf8_pat); - /* FALL THROUGH */ + /* FALLTHROUGH */ case EXACTFA: /* /abc/iaa */ folder = foldEQ_latin1; fold_array = PL_fold_latin1; @@ -4552,7 +4654,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) break; default: Perl_croak(aTHX_ "panic: Unexpected FLAGS %u in op %u", FLAGS(scan), OP(scan)); - break; } } /* Note requires that all BOUNDs be lower than all NBOUNDs in @@ -5088,9 +5189,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 { @@ -5130,7 +5228,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* and then jump to the code we share with EVAL */ goto eval_recurse_doit; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */ if (cur_eval && cur_eval->locinput==locinput) { @@ -5219,7 +5318,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 = o->op_sibling; + o = OP_SIBLING(o); } if (o->op_type != OP_STUB) { @@ -5346,7 +5445,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) re_sv = rex->engine->op_comp(aTHX_ &ret, 1, NULL, rex->engine, NULL, NULL, /* copy /msix etc to inner pattern */ - scan->flags, + ARG2L(scan), pm_flags); if (!(SvFLAGS(ret) @@ -5411,7 +5510,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) cur_eval = st; /* now continue from first node in postoned RE */ PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } case EVAL_AB: /* cleanup after a successful (??{A})B */ @@ -5520,7 +5620,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } } goto fake_end; - /*NOTREACHED*/ + /* NOTREACHED */ case GROUPP: /* (?(1)) */ n = ARG(scan); /* which paren pair */ @@ -5670,19 +5770,22 @@ NULL ST.lastloc = NULL; /* this will be updated by WHILEM */ PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next), locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } case CURLYX_end: /* just finished matching all of A*B */ cur_curlyx = ST.prev_curlyx; sayYES; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case CURLYX_end_fail: /* just failed to match all of A*B */ regcpblow(ST.cp); cur_curlyx = ST.prev_curlyx; sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); #undef ST @@ -5692,11 +5795,14 @@ NULL { /* see the discussion above about CURLYX/WHILEM */ I32 n; - int min = ARG1(cur_curlyx->u.curlyx.me); - int max = ARG2(cur_curlyx->u.curlyx.me); - regnode *A = NEXTOPER(cur_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS; + int min, max; + regnode *A; assert(cur_curlyx); /* keep Coverity happy */ + + min = ARG1(cur_curlyx->u.curlyx.me); + max = ARG2(cur_curlyx->u.curlyx.me); + A = NEXTOPER(cur_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS; n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */ ST.save_lastloc = cur_curlyx->u.curlyx.lastloc; ST.cache_offset = 0; @@ -5717,7 +5823,8 @@ NULL REGCP_SET(ST.lastcp); PUSH_STATE_GOTO(WHILEM_A_pre, A, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } /* If degenerate A matches "", assume A done. */ @@ -5829,7 +5936,8 @@ NULL REGCP_SET(ST.lastcp); PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } /* Prefer A over B for maximal matching. */ @@ -5840,34 +5948,39 @@ NULL cur_curlyx->u.curlyx.lastloc = locinput; REGCP_SET(ST.lastcp); PUSH_STATE_GOTO(WHILEM_A_max, A, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } goto do_whilem_B_max; } - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); 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; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case WHILEM_B_max_fail: /* just failed to match B in a maximal match */ cur_curlyx = ST.save_curlyx; cur_curlyx->u.curlyx.lastloc = ST.save_lastloc; cur_curlyx->u.curlyx.count--; CACHEsayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case WHILEM_A_min_fail: /* just failed to match A in a minimal match */ - /* FALL THROUGH */ + /* FALLTHROUGH */ case WHILEM_A_pre_fail: /* just failed to match even minimal A */ REGCP_UNWIND(ST.lastcp); regcppop(rex, &maxopenparen); cur_curlyx->u.curlyx.lastloc = ST.save_lastloc; cur_curlyx->u.curlyx.count--; CACHEsayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case WHILEM_A_max_fail: /* just failed to match A in a maximal match */ REGCP_UNWIND(ST.lastcp); @@ -5893,7 +6006,8 @@ NULL cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx; PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case WHILEM_B_min_fail: /* just failed to match B in a minimal match */ cur_curlyx = ST.save_curlyx; @@ -5927,7 +6041,8 @@ NULL PUSH_STATE_GOTO(WHILEM_A_min, /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); #undef ST #define ST st->u.branch @@ -5937,7 +6052,7 @@ NULL if (next == scan) next = NULL; scan = NEXTOPER(scan); - /* FALL THROUGH */ + /* FALLTHROUGH */ case BRANCH: /* /(...|A|...)/ */ scan = NEXTOPER(scan); /* scan now points to inner node */ @@ -5952,13 +6067,15 @@ NULL } else { PUSH_STATE_GOTO(BRANCH_next, scan, locinput); } - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); 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); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case CUTGROUP_next_fail: do_cutgroup = 1; @@ -5966,11 +6083,13 @@ NULL if (st->u.mark.mark_name) sv_commit = st->u.mark.mark_name; sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case BRANCH_next: sayYES; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case BRANCH_next_fail: /* that branch failed; try the next, if any */ if (do_cutgroup) { @@ -5992,7 +6111,8 @@ NULL sayNO_SILENT; } continue; /* execute next BRANCH[J] op */ - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case MINMOD: /* next op will be non-greedy, e.g. A*? */ minmod = 1; @@ -6036,7 +6156,8 @@ NULL curlym_do_A: /* execute the A in /A{m,n}B/ */ PUSH_YES_STATE_GOTO(CURLYM_A, ST.A, locinput); /* match A */ - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case CURLYM_A: /* we've just matched an A */ ST.count++; @@ -6086,6 +6207,7 @@ NULL /* calculate c1 and c2 for possible match of 1st char * following curly */ ST.c1 = ST.c2 = CHRTEST_VOID; + assert(ST.B); if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) { regnode *text_node = ST.B; if (! HAS_TEXT(text_node)) @@ -6171,7 +6293,8 @@ NULL } PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */ - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case CURLYM_B_fail: /* just failed to match a B */ REGCP_UNWIND(ST.cp); @@ -6349,8 +6472,8 @@ NULL REGCP_SET(ST.cp); goto curly_try_B_max; } - assert(0); /* NOTREACHED */ - + /* NOTREACHED */ + assert(0); case CURLY_B_min_known_fail: /* failed to find B in a non-greedy match where c1,c2 valid */ @@ -6425,8 +6548,8 @@ NULL } PUSH_STATE_GOTO(CURLY_B_min_known, ST.B, locinput); } - assert(0); /* NOTREACHED */ - + /* NOTREACHED */ + assert(0); case CURLY_B_min_fail: /* failed to find B in a non-greedy match where c1,c2 invalid */ @@ -6458,8 +6581,8 @@ NULL } } sayNO; - assert(0); /* NOTREACHED */ - + /* NOTREACHED */ + assert(0); curly_try_B_max: /* a successful greedy match: now try to match B */ @@ -6489,10 +6612,11 @@ NULL if (ST.c1 == CHRTEST_VOID || could_match) { CURLY_SETPAREN(ST.paren, ST.count); PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } } - /* FALL THROUGH */ + /* FALLTHROUGH */ case CURLY_B_max_fail: /* failed to find B in a greedy match */ @@ -6608,12 +6732,13 @@ NULL /* execute body of (?...A) */ PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)), newstart); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } case IFMATCH_A_fail: /* body of (?...A) failed */ ST.wanted = !ST.wanted; - /* FALL THROUGH */ + /* FALLTHROUGH */ case IFMATCH_A: /* body of (?...A) succeeded */ if (ST.logical) { @@ -6648,7 +6773,8 @@ NULL if (!scan->flags) sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); PUSH_STATE_GOTO(COMMIT_next, next, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case COMMIT_next_fail: no_final = 1; @@ -6656,7 +6782,8 @@ NULL case OPFAIL: /* (*FAIL) */ sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); #define ST st->u.mark case MARKPOINT: /* (*MARK:foo) */ @@ -6666,12 +6793,14 @@ NULL mark_state = st; ST.mark_loc = locinput; PUSH_YES_STATE_GOTO(MARKPOINT_next, next, locinput); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case MARKPOINT_next: mark_state = ST.prev_mark; sayYES; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case MARKPOINT_next_fail: if (popmark && sv_eq(ST.mark_name,popmark)) @@ -6692,7 +6821,8 @@ NULL sv_yes_mark = mark_state ? mark_state->u.mark.mark_name : NULL; sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case SKIP: /* (*SKIP) */ if (scan->flags) { @@ -6737,7 +6867,8 @@ NULL } no_final = 1; sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); #undef ST case LNBREAK: /* \R */ @@ -6771,13 +6902,14 @@ NULL /* switch break jumps here */ scan = next; /* prepare to execute the next op and ... */ continue; /* ... jump back to the top, reusing st */ - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); push_yes_state: /* push a state that backtracks on success */ st->u.yes.prev_yes_state = yes_state; yes_state = st; - /* FALL THROUGH */ + /* FALLTHROUGH */ push_state: /* push a new regex state, then continue at scan */ { @@ -6814,7 +6946,8 @@ NULL locinput = pushinput; st = newst; continue; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } } @@ -6823,7 +6956,7 @@ NULL * the terminating point. */ Perl_croak(aTHX_ "corrupted regexp pointers"); - /*NOTREACHED*/ + /* NOTREACHED */ sayNO; yes: @@ -6936,6 +7069,8 @@ no_silent: sv_commit = &PL_sv_yes; sv_yes_mark = &PL_sv_no; } + assert(sv_err); + assert(sv_mrk); sv_setsv(sv_err, sv_commit); sv_setsv(sv_mrk, sv_yes_mark); } @@ -6969,7 +7104,6 @@ STATIC I32 S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, regmatch_info *const reginfo, I32 max, int depth) { - dVAR; char *scan; /* Pointer to current position in target string */ I32 c; char *loceol = reginfo->strend; /* local version */ @@ -7112,7 +7246,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case EXACTFA_NO_TRIE: /* This node only generated for non-utf8 patterns */ assert(! reginfo->is_utf8_pat); - /* FALL THROUGH */ + /* FALLTHROUGH */ case EXACTFA: utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII; goto do_exactf; @@ -7252,7 +7386,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, to_complement = 1; goto utf8_posix; } - /* FALL THROUGH */ + /* FALLTHROUGH */ case NPOSIXA: if (! utf8_target) { @@ -7263,10 +7397,9 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, else { /* The complement of something that matches only ASCII matches all - * UTF-8 variant code points, plus everything in ASCII that isn't - * in the class. */ + * non-ASCII, plus everything in ASCII that isn't in the class. */ while (hardcount < max && scan < loceol - && (! UTF8_IS_INVARIANT(*scan) + && (! isASCII_utf8(scan) || ! _generic_isCC_A((U8) *scan, FLAGS(p)))) { scan += UTF8SKIP(scan); @@ -7334,7 +7467,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case _CC_ENUM_SPACE: /* XXX would require separate code if we revert the change of \v matching this */ - /* FALL THROUGH */ + /* FALLTHROUGH */ case _CC_ENUM_PSXSPC: while (hardcount < max && scan < loceol @@ -7450,7 +7583,8 @@ 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)]); - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } @@ -7464,7 +7598,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); @@ -7490,121 +7624,9 @@ 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 */ - - dVAR; - 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 { - *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))) { - - 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 = newSVpvn("", 0); - - /* 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) */ /* @@ -7647,22 +7669,25 @@ S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const } /* 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 @@ -7715,33 +7740,34 @@ 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; if (utf8_target) { utf8_p = (U8 *) p; } else { /* Convert to utf8 */ - STRLEN len = 1; - utf8_p = bytes_to_utf8(p, &len); + utf8_p = utf8_buffer; + append_utf8_from_native_byte(*p, &utf8_p); + utf8_p = utf8_buffer; } if (swash_fetch(sw, utf8_p, TRUE)) { match = TRUE; } - - /* If we allocated a string above, free it */ - if (! utf8_target) Safefree(utf8_p); } if (! match && only_utf8_locale && IN_UTF8_CTYPE_LOCALE) { match = _invlist_contains_cp(only_utf8_locale, c); @@ -7774,8 +7800,6 @@ S_reghop3(U8 *s, SSize_t off, const U8* lim) * '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; if (off >= 0) { @@ -7800,8 +7824,6 @@ S_reghop3(U8 *s, SSize_t off, const U8* lim) STATIC U8 * S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim) { - dVAR; - PERL_ARGS_ASSERT_REGHOP4; if (off >= 0) { @@ -7823,11 +7845,12 @@ S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim) return s; } +/* like reghop3, but returns NULL on overrun, rather than returning last + * char pos */ + STATIC U8 * S_reghopmaybe3(U8* s, SSize_t off, const U8* lim) { - dVAR; - PERL_ARGS_ASSERT_REGHOPMAYBE3; if (off >= 0) { @@ -7944,7 +7967,6 @@ S_setup_eval_state(pTHX_ regmatch_info *const reginfo) static void S_cleanup_regmatch_info_aux(pTHX_ void *arg) { - dVAR; regmatch_info_aux *aux = (regmatch_info_aux *) arg; regmatch_info_aux_eval *eval_state = aux->info_aux_eval; regmatch_slab *s; @@ -8036,7 +8058,6 @@ S_to_byte_substr(pTHX_ regexp *prog) /* Converts substr fields in prog from UTF-8 to bytes, calling fbm_compile * on the converted value; returns FALSE if can't be converted. */ - dVAR; int i = 1; PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;