X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=65a3b90e74db07078119d6f4b168be9cf5b53bf3;hb=54e82ce5cfd72fcdc60806373e0c4d6890b68a3c;hp=b464a40e8ad0431499068cffe7123b84a6091152;hpb=82ba1be6639bfd31cc63b76f90d26dc1dafd9221;p=p5sagit%2Fp5-mst-13.2.git diff --git a/regexec.c b/regexec.c index b464a40..65a3b90 100644 --- a/regexec.c +++ b/regexec.c @@ -278,7 +278,16 @@ S_cache_re(pTHX_ regexp *prog) /* 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 less calls to - regtry() should be needed. */ + 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 distingush positions; + We use 'a', 'b', multiline-part of 'c', and try to find a position in the + string which does not contradict any of them. + */ char * Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, @@ -293,6 +302,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, I32 ml_anch; char *tmp; register char *other_last = Nullch; +#ifdef DEBUGGING + char *i_strpos = strpos; +#endif DEBUG_r( if (!PL_colorset) reginitcolors() ); DEBUG_r(PerlIO_printf(Perl_debug_log, @@ -377,7 +389,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, #ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */ if (end_shift < 0) - croak("panic: end_shift"); + Perl_croak(aTHX_ "panic: end_shift"); #endif check = prog->check_substr; @@ -420,7 +432,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, goto fail_finish; /* Finish the diagnostic message */ - DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - strpos)) ); + DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) ); /* Got a candidate. Check MBOL anchoring, and the *other* substr. Start with the other substr. @@ -431,11 +443,13 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, */ if (prog->float_substr && prog->anchored_substr) { - /* Take into account the anchored substring. */ + /* Take into account the "other" substring. */ /* XXXX May be hopelessly wrong for UTF... */ if (!other_last) other_last = strpos - 1; if (check == prog->float_substr) { + do_other_anchored: + { char *last = s - start_shift, *last1, *last2; char *s1 = s; @@ -446,7 +460,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, || (PL_bostr = strpos, /* Used in regcopmaybe() */ (t = reghopmaybe_c(s, -(prog->check_offset_max))) && t > strpos))) - ; + /* EMPTY */; else t = strpos; t += prog->anchored_offset; @@ -478,7 +492,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } DEBUG_r(PerlIO_printf(Perl_debug_log, ", trying floating at offset %ld...\n", - (long)(s1 + 1 - strpos))); + (long)(s1 + 1 - i_strpos))); PL_regeol = strend; /* Used in HOP() */ other_last = last1 + prog->anchored_offset; s = HOPc(last, 1); @@ -486,14 +500,15 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } else { DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n", - (long)(s - strpos))); + (long)(s - i_strpos))); t = s - prog->anchored_offset; other_last = s - 1; + s = s1; if (t == strpos) goto try_at_start; - s = s1; goto try_at_offset; } + } } else { /* Take into account the floating substring. */ char *last, *last1; @@ -529,7 +544,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } DEBUG_r(PerlIO_printf(Perl_debug_log, ", trying anchored starting at offset %ld...\n", - (long)(s1 + 1 - strpos))); + (long)(s1 + 1 - i_strpos))); other_last = last; PL_regeol = strend; /* Used in HOP() */ s = HOPc(t, 1); @@ -537,11 +552,11 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } else { DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n", - (long)(s - strpos))); + (long)(s - i_strpos))); other_last = s - 1; + s = s1; if (t == strpos) goto try_at_start; - s = s1; goto try_at_offset; } } @@ -559,18 +574,36 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, cannot start at strpos. */ try_at_offset: if (ml_anch && t[-1] != '\n') { - find_anchor: /* Eventually fbm_*() should handle this */ + /* Eventually fbm_*() should handle this, but often + anchored_offset is not 0, so this check will not be wasted. */ + /* XXXX In the code below we prefer to look for "^" even in + presence of anchored substrings. And we search even + beyond the found float position. These pessimizations + are historical artefacts only. */ + find_anchor: while (t < strend - prog->minlen) { if (*t == '\n') { if (t < s - prog->check_offset_min) { + if (prog->anchored_substr) { + /* We definitely contradict the found anchored + substr. Due to the above check we do not + contradict "check" substr. + Thus we can arrive here only if check substr + is float. Redo checking for "other"=="fixed". + */ + strpos = t + 1; + DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n", + PL_colors[0],PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset))); + goto do_other_anchored; + } s = t + 1; DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n", - PL_colors[0],PL_colors[1], (long)(s - strpos))); + PL_colors[0],PL_colors[1], (long)(s - i_strpos))); goto set_useful; } DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting at offset %ld...\n", - PL_colors[0],PL_colors[1], (long)(t + 1 - strpos))); - s = t + 1; + PL_colors[0],PL_colors[1], (long)(t + 1 - i_strpos))); + strpos = s = t + 1; goto restart; } t++; @@ -596,8 +629,12 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, t = strpos; goto find_anchor; } + DEBUG_r( if (ml_anch) + PerlIO_printf(Perl_debug_log, "Does not contradict /%s^%s/m...\n", + PL_colors[0],PL_colors[1]); + ); success_at_start: - if (!(prog->reganch & ROPT_NAUGHTY) + if (!(prog->reganch & ROPT_NAUGHTY) /* XXXX If strpos moved? */ && --BmUSEFUL(prog->check_substr) < 0 && prog->check_substr == prog->float_substr) { /* boo */ /* If flags & SOMETHING - do not do it many times on the same match */ @@ -612,7 +649,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } DEBUG_r(PerlIO_printf(Perl_debug_log, "%sGuessed:%s match at offset %ld\n", - PL_colors[4], PL_colors[5], (long)(s - strpos)) ); + PL_colors[4], PL_colors[5], (long)(s - i_strpos)) ); return s; fail_finish: /* Substring not found */ @@ -642,7 +679,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * register I32 tmp; I32 minlen; /* must match at least this many chars */ I32 dontbother = 0; /* how many characters not to try at end */ - CURCUR cc; I32 start_shift = 0; /* Offset of the start to find constant substr. */ /* CC */ I32 end_shift = 0; /* Same for the end. */ /* CC */ @@ -650,9 +686,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * char *scream_olds; SV* oreplsv = GvSV(PL_replgv); - cc.cur = 0; - cc.oldcc = 0; - PL_regcc = &cc; + PL_regcc = 0; cache_re(prog); #ifdef DEBUGGING @@ -705,19 +739,23 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * /* If there is a "must appear" string, look for it. */ s = startpos; - if (prog->reganch & ROPT_GPOS_SEEN) { + if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */ MAGIC *mg; - if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG - && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) - PL_reg_ganch = strbeg + mg->mg_len; - else + if (flags & REXEC_IGNOREPOS) /* Means: check only at start */ PL_reg_ganch = startpos; - if (prog->reganch & ROPT_ANCH_GPOS) { - if (s > PL_reg_ganch) - goto phooey; - s = PL_reg_ganch; + else if (sv && SvTYPE(sv) >= SVt_PVMG + && SvMAGIC(sv) + && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) { + PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */ + if (prog->reganch & ROPT_ANCH_GPOS) { + if (s > PL_reg_ganch) + goto phooey; + s = PL_reg_ganch; + } } + else /* pos() not defined */ + PL_reg_ganch = strbeg; } if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) { @@ -758,9 +796,12 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * end = HOPc(strend, -dontbother) - 1; /* for multiline we only have to try after newlines */ if (prog->check_substr) { + if (s == startpos) + goto after_try; while (1) { if (regtry(prog, s)) goto got_it; + after_try: if (s >= end) goto phooey; s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL); @@ -884,7 +925,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * /* We know what class it must start with. */ switch (OP(c)) { case ANYOFUTF8: - cc = (char *) OPERAND(c); + cc = MASK(c); while (s < strend) { if (REGINCLASSUTF8(c, (U8*)s)) { if (tmp && regtry(prog, s)) @@ -898,7 +939,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } break; case ANYOF: - cc = (char *) OPERAND(c); + cc = MASK(c); while (s < strend) { if (REGINCLASS(cc, *s)) { if (tmp && regtry(prog, s)) @@ -1322,961 +1363,153 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * s += UTF8SKIP(s); } break; - case ALNUMC: - while (s < strend) { - if (isALNUMC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case ALNUMCUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_alnumc, (U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case ALNUMCL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isALNUMC_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case ALNUMCLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isALNUMC_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NALNUMC: - while (s < strend) { - if (!isALNUMC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; + } + } + else { + dontbother = 0; + if (prog->float_substr != Nullsv) { /* Trim the end. */ + char *last; + I32 oldpos = scream_pos; + + if (flags & REXEC_SCREAM) { + last = screaminstr(sv, prog->float_substr, s - strbeg, + end_shift, &scream_pos, 1); /* last one */ + if (!last) + last = scream_olds; /* Only one occurence. */ } - break; - case NALNUMCUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_alnumc, (U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; + else { + STRLEN len; + char *little = SvPV(prog->float_substr, len); + + if (SvTAIL(prog->float_substr)) { + if (memEQ(strend - len + 1, little, len - 1)) + last = strend - len + 1; + else if (!PL_multiline) + last = memEQ(strend - len, little, len) + ? strend - len : Nullch; else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NALNUMCL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isALNUMC_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; + goto find_last; + } else { + find_last: + if (len) + last = rninstr(s, strend, little, little + len); else - tmp = doevery; + last = strend; /* matching `$' */ } - else - tmp = 1; - s++; } - break; - case NALNUMCLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isALNUMC_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; + if (last == NULL) goto phooey; /* Should not happen! */ + dontbother = strend - last + prog->float_min_offset; + } + if (minlen && (dontbother < minlen)) + dontbother = minlen - 1; + strend -= dontbother; /* this one's always in bytes! */ + /* We don't know much -- general case. */ + if (UTF) { + for (;;) { + if (regtry(prog, s)) + goto got_it; + if (s >= strend) + break; s += UTF8SKIP(s); + }; + } + else { + do { + if (regtry(prog, s)) + goto got_it; + } while (s++ < strend); + } + } + + /* Failure. */ + goto phooey; + +got_it: + RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); + + if (PL_reg_eval_set) { + /* Preserve the current value of $^R */ + if (oreplsv != GvSV(PL_replgv)) + sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is + restored, the value remains + the same. */ + restore_pos(aTHXo_ 0); + } + + /* make sure $`, $&, $', and $digit will work later */ + if ( !(flags & REXEC_NOT_FIRST) ) { + if (RX_MATCH_COPIED(prog)) { + Safefree(prog->subbeg); + RX_MATCH_COPIED_off(prog); + } + if (flags & REXEC_COPY_STR) { + I32 i = PL_regeol - startpos + (stringarg - strbeg); + + s = savepvn(strbeg, i); + prog->subbeg = s; + prog->sublen = i; + RX_MATCH_COPIED_on(prog); + } + else { + prog->subbeg = strbeg; + prog->sublen = PL_regeol - strbeg; /* strend may have been modified */ + } + } + + return 1; + +phooey: + if (PL_reg_eval_set) + restore_pos(aTHXo_ 0); + return 0; +} + +/* + - regtry - try match at specific point + */ +STATIC I32 /* 0 failure, 1 success */ +S_regtry(pTHX_ regexp *prog, char *startpos) +{ + dTHR; + register I32 i; + register I32 *sp; + register I32 *ep; + CHECKPOINT lastcp; + + if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) { + MAGIC *mg; + + PL_reg_eval_set = RS_init; + DEBUG_r(DEBUG_s( + PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n", + PL_stack_sp - PL_stack_base); + )); + SAVEINT(cxstack[cxstack_ix].blk_oldsp); + cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base; + /* Otherwise OP_NEXTSTATE will free whatever on stack now. */ + SAVETMPS; + /* Apparently this is not needed, judging by wantarray. */ + /* SAVEINT(cxstack[cxstack_ix].blk_gimme); + cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ + + if (PL_reg_sv) { + /* Make $_ available to executed code. */ + if (PL_reg_sv != DEFSV) { + /* SAVE_DEFSV does *not* suffice here for USE_THREADS */ + SAVESPTR(DEFSV); + DEFSV = PL_reg_sv; } - break; - case ASCII: - while (s < strend) { - if (isASCII(*(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NASCII: - while (s < strend) { - if (!isASCII(*(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case CNTRL: - while (s < strend) { - if (isCNTRL(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case CNTRLUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_cntrl,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case CNTRLL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isCNTRL_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case CNTRLLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (*s == ' ' || isCNTRL_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NCNTRL: - while (s < strend) { - if (!isCNTRL(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NCNTRLUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_cntrl,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NCNTRLL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isCNTRL_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NCNTRLLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isCNTRL_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case GRAPH: - while (s < strend) { - if (isGRAPH(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case GRAPHUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_graph,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case GRAPHL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isGRAPH_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case GRAPHLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (*s == ' ' || isGRAPH_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NGRAPH: - while (s < strend) { - if (!isGRAPH(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NGRAPHUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_graph,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NGRAPHL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isGRAPH_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NGRAPHLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isGRAPH_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case LOWER: - while (s < strend) { - if (isLOWER(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case LOWERUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_lower,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case LOWERL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isLOWER_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case LOWERLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (*s == ' ' || isLOWER_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NLOWER: - while (s < strend) { - if (!isLOWER(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NLOWERUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_lower,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NLOWERL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isLOWER_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NLOWERLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isLOWER_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case PRINT: - while (s < strend) { - if (isPRINT(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case PRINTUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_print,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case PRINTL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isPRINT_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case PRINTLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (*s == ' ' || isPRINT_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NPRINT: - while (s < strend) { - if (!isPRINT(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NPRINTUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_print,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NPRINTL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isPRINT_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NPRINTLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isPRINT_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case PUNCT: - while (s < strend) { - if (isPUNCT(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case PUNCTUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_punct,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case PUNCTL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isPUNCT_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case PUNCTLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (*s == ' ' || isPUNCT_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NPUNCT: - while (s < strend) { - if (!isPUNCT(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NPUNCTUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_punct,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NPUNCTL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isPUNCT_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NPUNCTLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isPUNCT_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case UPPER: - while (s < strend) { - if (isUPPER(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case UPPERUTF8: - while (s < strend) { - if (swash_fetch(PL_utf8_upper,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case UPPERL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (isUPPER_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case UPPERLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (*s == ' ' || isUPPER_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NUPPER: - while (s < strend) { - if (!isUPPER(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NUPPERUTF8: - while (s < strend) { - if (!swash_fetch(PL_utf8_upper,(U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case NUPPERL: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isUPPER_LC(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NUPPERLUTF8: - PL_reg_flags |= RF_tainted; - while (s < strend) { - if (!isUPPER_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case XDIGIT: - while (s < strend) { - if (isXDIGIT(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case NXDIGIT: - while (s < strend) { - if (!isXDIGIT(*s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - } - } - else { - dontbother = 0; - if (prog->float_substr != Nullsv) { /* Trim the end. */ - char *last; - I32 oldpos = scream_pos; - - if (flags & REXEC_SCREAM) { - last = screaminstr(sv, prog->float_substr, s - strbeg, - end_shift, &scream_pos, 1); /* last one */ - if (!last) - last = scream_olds; /* Only one occurence. */ - } - else { - STRLEN len; - char *little = SvPV(prog->float_substr, len); - - if (SvTAIL(prog->float_substr)) { - if (memEQ(strend - len + 1, little, len - 1)) - last = strend - len + 1; - else if (!PL_multiline) - last = memEQ(strend - len, little, len) - ? strend - len : Nullch; - else - goto find_last; - } else { - find_last: - if (len) - last = rninstr(s, strend, little, little + len); - else - last = strend; /* matching `$' */ - } - } - if (last == NULL) goto phooey; /* Should not happen! */ - dontbother = strend - last + prog->float_min_offset; - } - if (minlen && (dontbother < minlen)) - dontbother = minlen - 1; - strend -= dontbother; /* this one's always in bytes! */ - /* We don't know much -- general case. */ - if (UTF) { - for (;;) { - if (regtry(prog, s)) - goto got_it; - if (s >= strend) - break; - s += UTF8SKIP(s); - }; - } - else { - do { - if (regtry(prog, s)) - goto got_it; - } while (s++ < strend); - } - } - - /* Failure. */ - goto phooey; - -got_it: - RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); - - if (PL_reg_eval_set) { - /* Preserve the current value of $^R */ - if (oreplsv != GvSV(PL_replgv)) - sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is - restored, the value remains - the same. */ - restore_pos(aTHXo_ 0); - } - - /* make sure $`, $&, $', and $digit will work later */ - if ( !(flags & REXEC_NOT_FIRST) ) { - if (RX_MATCH_COPIED(prog)) { - Safefree(prog->subbeg); - RX_MATCH_COPIED_off(prog); - } - if (flags & REXEC_COPY_STR) { - I32 i = PL_regeol - startpos + (stringarg - strbeg); - - s = savepvn(strbeg, i); - prog->subbeg = s; - prog->sublen = i; - RX_MATCH_COPIED_on(prog); - } - else { - prog->subbeg = strbeg; - prog->sublen = PL_regeol - strbeg; /* strend may have been modified */ - } - } - - return 1; - -phooey: - if (PL_reg_eval_set) - restore_pos(aTHXo_ 0); - return 0; -} - -/* - - regtry - try match at specific point - */ -STATIC I32 /* 0 failure, 1 success */ -S_regtry(pTHX_ regexp *prog, char *startpos) -{ - dTHR; - register I32 i; - register I32 *sp; - register I32 *ep; - CHECKPOINT lastcp; - - if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) { - MAGIC *mg; - - PL_reg_eval_set = RS_init; - DEBUG_r(DEBUG_s( - PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n", - PL_stack_sp - PL_stack_base); - )); - SAVEINT(cxstack[cxstack_ix].blk_oldsp); - cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base; - /* Otherwise OP_NEXTSTATE will free whatever on stack now. */ - SAVETMPS; - /* Apparently this is not needed, judging by wantarray. */ - /* SAVEINT(cxstack[cxstack_ix].blk_gimme); - cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ - - if (PL_reg_sv) { - /* Make $_ available to executed code. */ - if (PL_reg_sv != DEFSV) { - /* SAVE_DEFSV does *not* suffice here for USE_THREADS */ - SAVESPTR(DEFSV); - DEFSV = PL_reg_sv; - } - - if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) - && (mg = mg_find(PL_reg_sv, 'g')))) { - /* prepare for quick setting of pos */ - sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0); - mg = mg_find(PL_reg_sv, 'g'); - mg->mg_len = -1; + + if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) + && (mg = mg_find(PL_reg_sv, 'g')))) { + /* prepare for quick setting of pos */ + sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0); + mg = mg_find(PL_reg_sv, 'g'); + mg->mg_len = -1; } PL_reg_magic = mg; PL_reg_oldpos = mg->mg_len; - SAVEDESTRUCTOR(restore_pos, 0); + SAVEDESTRUCTOR_X(restore_pos, 0); } if (!PL_reg_curpm) New(22,PL_reg_curpm, 1, PMOP); @@ -2346,748 +1579,267 @@ S_regtry(pTHX_ regexp *prog, char *startpos) * maybe save a little bit of pushing and popping on the stack. It also takes * advantage of machines that use a register save mask on subroutine entry. */ -STATIC I32 /* 0 failure, 1 success */ -S_regmatch(pTHX_ regnode *prog) -{ - dTHR; - register regnode *scan; /* Current node. */ - regnode *next; /* Next node. */ - regnode *inner; /* Next node in internal branch. */ - register I32 nextchr; /* renamed nextchr - nextchar colides with - function of same name */ - register I32 n; /* no or next */ - register I32 ln; /* len or last */ - register char *s; /* operand or save */ - register char *locinput = PL_reginput; - register I32 c1, c2, paren; /* case fold search, parenth */ - int minmod = 0, sw = 0, logical = 0; -#ifdef DEBUGGING - PL_regindent++; -#endif - - /* Note that nextchr is a byte even in UTF */ - nextchr = UCHARAT(locinput); - scan = prog; - while (scan != NULL) { -#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO) -#ifdef DEBUGGING -# define sayYES goto yes -# define sayNO goto no -# define saySAME(x) if (x) goto yes; else goto no -# define REPORT_CODE_OFF 24 -#else -# define sayYES return 1 -# define sayNO return 0 -# define saySAME(x) return x -#endif - DEBUG_r( { - SV *prop = sv_newmortal(); - int docolor = *PL_colors[0]; - int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */ - int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput); - /* The part of the string before starttry has one color - (pref0_len chars), between starttry and current - position another one (pref_len - pref0_len chars), - after the current position the third one. - We assume that pref0_len <= pref_len, otherwise we - decrease pref0_len. */ - int pref_len = (locinput - PL_bostr > (5 + taill) - l - ? (5 + taill) - l : locinput - PL_bostr); - int pref0_len = pref_len - (locinput - PL_reg_starttry); - - if (l + pref_len < (5 + taill) && l < PL_regeol - locinput) - l = ( PL_regeol - locinput > (5 + taill) - pref_len - ? (5 + taill) - pref_len : PL_regeol - locinput); - if (pref0_len < 0) - pref0_len = 0; - if (pref0_len > pref_len) - pref0_len = pref_len; - regprop(prop, scan); - PerlIO_printf(Perl_debug_log, - "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n", - locinput - PL_bostr, - PL_colors[4], pref0_len, - locinput - pref_len, PL_colors[5], - PL_colors[2], pref_len - pref0_len, - locinput - pref_len + pref0_len, PL_colors[3], - (docolor ? "" : "> <"), - PL_colors[0], l, locinput, PL_colors[1], - 15 - l - pref_len + 1, - "", - scan - PL_regprogram, PL_regindent*2, "", - SvPVX(prop)); - } ); - - next = scan + NEXT_OFF(scan); - if (next == scan) - next = NULL; - - switch (OP(scan)) { - case BOL: - if (locinput == PL_bostr - ? PL_regprev == '\n' - : (PL_multiline && - (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) - { - /* regtill = regbol; */ - break; - } - sayNO; - case MBOL: - if (locinput == PL_bostr - ? PL_regprev == '\n' - : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) - { - break; - } - sayNO; - case SBOL: - if (locinput == PL_regbol && PL_regprev == '\n') - break; - sayNO; - case GPOS: - if (locinput == PL_reg_ganch) - break; - sayNO; - case EOL: - if (PL_multiline) - goto meol; - else - goto seol; - case MEOL: - meol: - if ((nextchr || locinput < PL_regeol) && nextchr != '\n') - sayNO; - break; - case SEOL: - seol: - if ((nextchr || locinput < PL_regeol) && nextchr != '\n') - sayNO; - if (PL_regeol - locinput > 1) - sayNO; - break; - case EOS: - if (PL_regeol != locinput) - sayNO; - break; - case SANYUTF8: - if (nextchr & 0x80) { - locinput += PL_utf8skip[nextchr]; - if (locinput > PL_regeol) - sayNO; - nextchr = UCHARAT(locinput); - break; - } - if (!nextchr && locinput >= PL_regeol) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case SANY: - if (!nextchr && locinput >= PL_regeol) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ANYUTF8: - if (nextchr & 0x80) { - locinput += PL_utf8skip[nextchr]; - if (locinput > PL_regeol) - sayNO; - nextchr = UCHARAT(locinput); - break; - } - if (!nextchr && locinput >= PL_regeol || nextchr == '\n') - sayNO; - nextchr = UCHARAT(++locinput); - break; - case REG_ANY: - if (!nextchr && locinput >= PL_regeol || nextchr == '\n') - sayNO; - nextchr = UCHARAT(++locinput); - break; - case EXACT: - s = (char *) OPERAND(scan); - ln = UCHARAT(s++); - /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchr) - sayNO; - if (PL_regeol - locinput < ln) - sayNO; - if (ln > 1 && memNE(s, locinput, ln)) - sayNO; - locinput += ln; - nextchr = UCHARAT(locinput); - break; - case EXACTFL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case EXACTF: - s = (char *) OPERAND(scan); - ln = UCHARAT(s++); +STATIC I32 /* 0 failure, 1 success */ +S_regmatch(pTHX_ regnode *prog) +{ + dTHR; + register regnode *scan; /* Current node. */ + regnode *next; /* Next node. */ + regnode *inner; /* Next node in internal branch. */ + register I32 nextchr; /* renamed nextchr - nextchar colides with + function of same name */ + register I32 n; /* no or next */ + register I32 ln; /* len or last */ + register char *s; /* operand or save */ + register char *locinput = PL_reginput; + register I32 c1, c2, paren; /* case fold search, parenth */ + int minmod = 0, sw = 0, logical = 0; +#ifdef DEBUGGING + PL_regindent++; +#endif - if (UTF) { - char *l = locinput; - char *e = s + ln; - c1 = OP(scan) == EXACTF; - while (s < e) { - if (l >= PL_regeol) - sayNO; - if (utf8_to_uv((U8*)s, 0) != (c1 ? - toLOWER_utf8((U8*)l) : - toLOWER_LC_utf8((U8*)l))) - { - sayNO; - } - s += UTF8SKIP(s); - l += UTF8SKIP(l); - } - locinput = l; - nextchr = UCHARAT(locinput); - break; - } + /* Note that nextchr is a byte even in UTF */ + nextchr = UCHARAT(locinput); + scan = prog; + while (scan != NULL) { +#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO) +#ifdef DEBUGGING +# define sayYES goto yes +# define sayNO goto no +# define sayYES_FINAL goto yes_final +# define sayYES_LOUD goto yes_loud +# define sayNO_FINAL goto no_final +# define sayNO_SILENT goto do_no +# define saySAME(x) if (x) goto yes; else goto no +# define REPORT_CODE_OFF 24 +#else +# define sayYES return 1 +# define sayNO return 0 +# define sayYES_FINAL return 1 +# define sayYES_LOUD return 1 +# define sayNO_FINAL return 0 +# define sayNO_SILENT return 0 +# define saySAME(x) return x +#endif + DEBUG_r( { + SV *prop = sv_newmortal(); + int docolor = *PL_colors[0]; + int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */ + int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput); + /* The part of the string before starttry has one color + (pref0_len chars), between starttry and current + position another one (pref_len - pref0_len chars), + after the current position the third one. + We assume that pref0_len <= pref_len, otherwise we + decrease pref0_len. */ + int pref_len = (locinput - PL_bostr > (5 + taill) - l + ? (5 + taill) - l : locinput - PL_bostr); + int pref0_len = pref_len - (locinput - PL_reg_starttry); - /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchr && - UCHARAT(s) != ((OP(scan) == EXACTF) - ? PL_fold : PL_fold_locale)[nextchr]) - sayNO; - if (PL_regeol - locinput < ln) - sayNO; - if (ln > 1 && (OP(scan) == EXACTF - ? ibcmp(s, locinput, ln) - : ibcmp_locale(s, locinput, ln))) - sayNO; - locinput += ln; - nextchr = UCHARAT(locinput); - break; - case ANYOFUTF8: - s = (char *) OPERAND(scan); - if (!REGINCLASSUTF8(scan, (U8*)locinput)) - sayNO; - if (locinput >= PL_regeol) - sayNO; - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - case ANYOF: - s = (char *) OPERAND(scan); - if (nextchr < 0) - nextchr = UCHARAT(locinput); - if (!REGINCLASS(s, nextchr)) - sayNO; - if (!nextchr && locinput >= PL_regeol) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ALNUML: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case ALNUM: - if (!nextchr) - sayNO; - if (!(OP(scan) == ALNUM - ? isALNUM(nextchr) : isALNUM_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ALNUMLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case ALNUMUTF8: - if (!nextchr) - sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == ALNUMUTF8 - ? swash_fetch(PL_utf8_alnum, (U8*)locinput) - : isALNUM_LC_utf8((U8*)locinput))) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (!(OP(scan) == ALNUMUTF8 - ? isALNUM(nextchr) : isALNUM_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NALNUML: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NALNUM: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (OP(scan) == NALNUM - ? isALNUM(nextchr) : isALNUM_LC(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NALNUMLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NALNUMUTF8: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (nextchr & 0x80) { - if (OP(scan) == NALNUMUTF8 - ? swash_fetch(PL_utf8_alnum, (U8*)locinput) - : isALNUM_LC_utf8((U8*)locinput)) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (OP(scan) == NALNUMUTF8 - ? isALNUM(nextchr) : isALNUM_LC(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case BOUNDL: - case NBOUNDL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case BOUND: - case NBOUND: - /* was last char in word? */ - ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev; - if (OP(scan) == BOUND || OP(scan) == NBOUND) { - ln = isALNUM(ln); - n = isALNUM(nextchr); - } - else { - ln = isALNUM_LC(ln); - n = isALNUM_LC(nextchr); - } - if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL)) - sayNO; - break; - case BOUNDLUTF8: - case NBOUNDLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case BOUNDUTF8: - case NBOUNDUTF8: - /* was last char in word? */ - ln = (locinput != PL_regbol) - ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev; - if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) { - ln = isALNUM_uni(ln); - n = swash_fetch(PL_utf8_alnum, (U8*)locinput); - } - else { - ln = isALNUM_LC_uni(ln); - n = isALNUM_LC_utf8((U8*)locinput); - } - if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8)) - sayNO; - break; - case SPACEL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case SPACE: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (!(OP(scan) == SPACE - ? isSPACE(nextchr) : isSPACE_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case SPACELUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case SPACEUTF8: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == SPACEUTF8 - ? swash_fetch(PL_utf8_space,(U8*)locinput) - : isSPACE_LC_utf8((U8*)locinput))) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); + if (l + pref_len < (5 + taill) && l < PL_regeol - locinput) + l = ( PL_regeol - locinput > (5 + taill) - pref_len + ? (5 + taill) - pref_len : PL_regeol - locinput); + if (pref0_len < 0) + pref0_len = 0; + if (pref0_len > pref_len) + pref0_len = pref_len; + regprop(prop, scan); + PerlIO_printf(Perl_debug_log, + "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n", + locinput - PL_bostr, + PL_colors[4], pref0_len, + locinput - pref_len, PL_colors[5], + PL_colors[2], pref_len - pref0_len, + locinput - pref_len + pref0_len, PL_colors[3], + (docolor ? "" : "> <"), + PL_colors[0], l, locinput, PL_colors[1], + 15 - l - pref_len + 1, + "", + scan - PL_regprogram, PL_regindent*2, "", + SvPVX(prop)); + } ); + + next = scan + NEXT_OFF(scan); + if (next == scan) + next = NULL; + + switch (OP(scan)) { + case BOL: + if (locinput == PL_bostr + ? PL_regprev == '\n' + : (PL_multiline && + (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) + { + /* regtill = regbol; */ break; } - if (!(OP(scan) == SPACEUTF8 - ? isSPACE(nextchr) : isSPACE_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NSPACEL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NSPACE: - if (!nextchr) - sayNO; - if (OP(scan) == SPACE - ? isSPACE(nextchr) : isSPACE_LC(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NSPACELUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NSPACEUTF8: - if (!nextchr) - sayNO; - if (nextchr & 0x80) { - if (OP(scan) == NSPACEUTF8 - ? swash_fetch(PL_utf8_space,(U8*)locinput) - : isSPACE_LC_utf8((U8*)locinput)) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); + sayNO; + case MBOL: + if (locinput == PL_bostr + ? PL_regprev == '\n' + : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) + { break; } - if (OP(scan) == NSPACEUTF8 - ? isSPACE(nextchr) : isSPACE_LC(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case DIGITL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case DIGIT: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (!(OP(scan) == DIGIT - ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case DIGITLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case DIGITUTF8: - if (!nextchr) - sayNO; - if (nextchr & 0x80) { - if (OP(scan) == NDIGITUTF8 - ? swash_fetch(PL_utf8_digit,(U8*)locinput) - : isDIGIT_LC_utf8((U8*)locinput)) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); + sayNO; + case SBOL: + if (locinput == PL_regbol && PL_regprev == '\n') break; - } - if (!isDIGIT(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NDIGITL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NDIGIT: - if (!nextchr) - sayNO; - if (OP(scan) == DIGIT - ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NDIGITLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NDIGITUTF8: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_digit,(U8*)locinput)) - sayNO; - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); + sayNO; + case GPOS: + if (locinput == PL_reg_ganch) break; - } - if (isDIGIT(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ALNUMCL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case ALNUMC: - if (!nextchr) - sayNO; - if (!(OP(scan) == ALNUMC - ? isALNUMC(nextchr) : isALNUMC_LC(nextchr))) + sayNO; + case EOL: + if (PL_multiline) + goto meol; + else + goto seol; + case MEOL: + meol: + if ((nextchr || locinput < PL_regeol) && nextchr != '\n') sayNO; - nextchr = UCHARAT(++locinput); break; - case ALNUMCLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case ALNUMCUTF8: - if (!nextchr) + case SEOL: + seol: + if ((nextchr || locinput < PL_regeol) && nextchr != '\n') sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == ALNUMCUTF8 - ? swash_fetch(PL_utf8_alnumc, (U8*)locinput) - : isALNUMC_LC_utf8((U8*)locinput))) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (!(OP(scan) == ALNUMCUTF8 - ? isALNUMC(nextchr) : isALNUMC_LC(nextchr))) + if (PL_regeol - locinput > 1) sayNO; - nextchr = UCHARAT(++locinput); break; - case NALNUMCL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NALNUMC: - if (!nextchr) - sayNO; - if (OP(scan) == ALNUMC - ? isALNUMC(nextchr) : isALNUMC_LC(nextchr)) + case EOS: + if (PL_regeol != locinput) sayNO; - nextchr = UCHARAT(++locinput); break; - case NALNUMCLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NALNUMCUTF8: - if (!nextchr && locinput >= PL_regeol) - sayNO; + case SANYUTF8: if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_alnumc,(U8*)locinput)) - sayNO; locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (isALNUMC(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ALPHAL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case ALPHA: - if (!nextchr) - sayNO; - if (!(OP(scan) == ALPHA - ? isALPHA(nextchr) : isALPHA_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ALPHALUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case ALPHAUTF8: - if (!nextchr) - sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == ALPHAUTF8 - ? swash_fetch(PL_utf8_alpha, (U8*)locinput) - : isALPHA_LC_utf8((U8*)locinput))) - { + if (locinput > PL_regeol) sayNO; - } - locinput += PL_utf8skip[nextchr]; nextchr = UCHARAT(locinput); break; } - if (!(OP(scan) == ALPHAUTF8 - ? isALPHA(nextchr) : isALPHA_LC(nextchr))) + if (!nextchr && locinput >= PL_regeol) sayNO; nextchr = UCHARAT(++locinput); break; - case NALPHAL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NALPHA: - if (!nextchr) - sayNO; - if (OP(scan) == ALPHA - ? isALPHA(nextchr) : isALPHA_LC(nextchr)) + case SANY: + if (!nextchr && locinput >= PL_regeol) sayNO; nextchr = UCHARAT(++locinput); break; - case NALPHALUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NALPHAUTF8: - if (!nextchr && locinput >= PL_regeol) - sayNO; + case ANYUTF8: if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_alpha,(U8*)locinput)) - sayNO; locinput += PL_utf8skip[nextchr]; + if (locinput > PL_regeol) + sayNO; nextchr = UCHARAT(locinput); break; } - if (isALPHA(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case ASCII: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (!isASCII(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NASCII: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (isASCII(nextchr)) + if (!nextchr && locinput >= PL_regeol || nextchr == '\n') sayNO; nextchr = UCHARAT(++locinput); break; - case CNTRLL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case CNTRL: - if (!nextchr) - sayNO; - if (!(OP(scan) == CNTRL - ? isCNTRL(nextchr) : isCNTRL_LC(nextchr))) + case REG_ANY: + if (!nextchr && locinput >= PL_regeol || nextchr == '\n') sayNO; nextchr = UCHARAT(++locinput); break; - case CNTRLLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case CNTRLUTF8: - if (!nextchr) - sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == CNTRLUTF8 - ? swash_fetch(PL_utf8_cntrl, (U8*)locinput) - : isCNTRL_LC_utf8((U8*)locinput))) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (!(OP(scan) == CNTRLUTF8 - ? isCNTRL(nextchr) : isCNTRL_LC(nextchr))) + case EXACT: + s = STRING(scan); + ln = STR_LEN(scan); + /* Inline the first character, for speed. */ + if (UCHARAT(s) != nextchr) sayNO; - nextchr = UCHARAT(++locinput); - break; - case NCNTRLL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NCNTRL: - if (!nextchr) + if (PL_regeol - locinput < ln) sayNO; - if (OP(scan) == CNTRL - ? isCNTRL(nextchr) : isCNTRL_LC(nextchr)) + if (ln > 1 && memNE(s, locinput, ln)) sayNO; - nextchr = UCHARAT(++locinput); + locinput += ln; + nextchr = UCHARAT(locinput); break; - case NCNTRLLUTF8: + case EXACTFL: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NCNTRLUTF8: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_cntrl,(U8*)locinput)) - sayNO; - locinput += PL_utf8skip[nextchr]; + case EXACTF: + s = STRING(scan); + ln = STR_LEN(scan); + + if (UTF) { + char *l = locinput; + char *e = s + ln; + c1 = OP(scan) == EXACTF; + while (s < e) { + if (l >= PL_regeol) + sayNO; + if (utf8_to_uv((U8*)s, 0) != (c1 ? + toLOWER_utf8((U8*)l) : + toLOWER_LC_utf8((U8*)l))) + { + sayNO; + } + s += UTF8SKIP(s); + l += UTF8SKIP(l); + } + locinput = l; nextchr = UCHARAT(locinput); break; } - if (isCNTRL(nextchr)) + + /* Inline the first character, for speed. */ + if (UCHARAT(s) != nextchr && + UCHARAT(s) != ((OP(scan) == EXACTF) + ? PL_fold : PL_fold_locale)[nextchr]) sayNO; - nextchr = UCHARAT(++locinput); - break; - case GRAPHL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case GRAPH: - if (!nextchr) + if (PL_regeol - locinput < ln) sayNO; - if (!(OP(scan) == GRAPH - ? isGRAPH(nextchr) : isGRAPH_LC(nextchr))) + if (ln > 1 && (OP(scan) == EXACTF + ? ibcmp(s, locinput, ln) + : ibcmp_locale(s, locinput, ln))) sayNO; - nextchr = UCHARAT(++locinput); + locinput += ln; + nextchr = UCHARAT(locinput); break; - case GRAPHLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case GRAPHUTF8: - if (!nextchr) + case ANYOFUTF8: + s = MASK(scan); + if (!REGINCLASSUTF8(scan, (U8*)locinput)) sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == GRAPHUTF8 - ? swash_fetch(PL_utf8_graph, (U8*)locinput) - : isGRAPH_LC_utf8((U8*)locinput))) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (!(OP(scan) == GRAPHUTF8 - ? isGRAPH(nextchr) : isGRAPH_LC(nextchr))) + if (locinput >= PL_regeol) sayNO; - nextchr = UCHARAT(++locinput); + locinput += PL_utf8skip[nextchr]; + nextchr = UCHARAT(locinput); break; - case NGRAPHL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NGRAPH: - if (!nextchr) - sayNO; - if (OP(scan) == GRAPH - ? isGRAPH(nextchr) : isGRAPH_LC(nextchr)) + case ANYOF: + s = MASK(scan); + if (nextchr < 0) + nextchr = UCHARAT(locinput); + if (!REGINCLASS(s, nextchr)) sayNO; - nextchr = UCHARAT(++locinput); - break; - case NGRAPHLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NGRAPHUTF8: if (!nextchr && locinput >= PL_regeol) sayNO; - if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_graph,(U8*)locinput)) - sayNO; - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (isGRAPH(nextchr)) - sayNO; nextchr = UCHARAT(++locinput); break; - case LOWERL: + case ALNUML: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case LOWER: + case ALNUM: if (!nextchr) sayNO; - if (!(OP(scan) == LOWER - ? isLOWER(nextchr) : isLOWER_LC(nextchr))) + if (!(OP(scan) == ALNUM + ? isALNUM(nextchr) : isALNUM_LC(nextchr))) sayNO; nextchr = UCHARAT(++locinput); break; - case LOWERLUTF8: + case ALNUMLUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case LOWERUTF8: + case ALNUMUTF8: if (!nextchr) sayNO; if (nextchr & 0x80) { - if (!(OP(scan) == LOWERUTF8 - ? swash_fetch(PL_utf8_lower, (U8*)locinput) - : isLOWER_LC_utf8((U8*)locinput))) + if (!(OP(scan) == ALNUMUTF8 + ? swash_fetch(PL_utf8_alnum, (U8*)locinput) + : isALNUM_LC_utf8((U8*)locinput))) { sayNO; } @@ -3095,121 +1847,137 @@ S_regmatch(pTHX_ regnode *prog) nextchr = UCHARAT(locinput); break; } - if (!(OP(scan) == LOWERUTF8 - ? isLOWER(nextchr) : isLOWER_LC(nextchr))) + if (!(OP(scan) == ALNUMUTF8 + ? isALNUM(nextchr) : isALNUM_LC(nextchr))) sayNO; nextchr = UCHARAT(++locinput); break; - case NLOWERL: + case NALNUML: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NLOWER: - if (!nextchr) + case NALNUM: + if (!nextchr && locinput >= PL_regeol) sayNO; - if (OP(scan) == LOWER - ? isLOWER(nextchr) : isLOWER_LC(nextchr)) + if (OP(scan) == NALNUM + ? isALNUM(nextchr) : isALNUM_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; - case NLOWERLUTF8: + case NALNUMLUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NLOWERUTF8: + case NALNUMUTF8: if (!nextchr && locinput >= PL_regeol) sayNO; if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_lower,(U8*)locinput)) + if (OP(scan) == NALNUMUTF8 + ? swash_fetch(PL_utf8_alnum, (U8*)locinput) + : isALNUM_LC_utf8((U8*)locinput)) + { sayNO; + } locinput += PL_utf8skip[nextchr]; nextchr = UCHARAT(locinput); break; } - if (isLOWER(nextchr)) + if (OP(scan) == NALNUMUTF8 + ? isALNUM(nextchr) : isALNUM_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; - case PRINTL: + case BOUNDL: + case NBOUNDL: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case PRINT: - if (!nextchr) - sayNO; - if (!(OP(scan) == PRINT - ? isPRINT(nextchr) : isPRINT_LC(nextchr))) + case BOUND: + case NBOUND: + /* was last char in word? */ + ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev; + if (OP(scan) == BOUND || OP(scan) == NBOUND) { + ln = isALNUM(ln); + n = isALNUM(nextchr); + } + else { + ln = isALNUM_LC(ln); + n = isALNUM_LC(nextchr); + } + if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL)) sayNO; - nextchr = UCHARAT(++locinput); break; - case PRINTLUTF8: + case BOUNDLUTF8: + case NBOUNDLUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case PRINTUTF8: - if (!nextchr) - sayNO; - if (nextchr & 0x80) { - if (!(OP(scan) == PRINTUTF8 - ? swash_fetch(PL_utf8_print, (U8*)locinput) - : isPRINT_LC_utf8((U8*)locinput))) - { - sayNO; - } - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; + case BOUNDUTF8: + case NBOUNDUTF8: + /* was last char in word? */ + ln = (locinput != PL_regbol) + ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev; + if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) { + ln = isALNUM_uni(ln); + n = swash_fetch(PL_utf8_alnum, (U8*)locinput); + } + else { + ln = isALNUM_LC_uni(ln); + n = isALNUM_LC_utf8((U8*)locinput); } - if (!(OP(scan) == PRINTUTF8 - ? isPRINT(nextchr) : isPRINT_LC(nextchr))) + if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8)) sayNO; - nextchr = UCHARAT(++locinput); break; - case NPRINTL: + case SPACEL: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NPRINT: - if (!nextchr) + case SPACE: + if (!nextchr && locinput >= PL_regeol) sayNO; - if (OP(scan) == PRINT - ? isPRINT(nextchr) : isPRINT_LC(nextchr)) + if (!(OP(scan) == SPACE + ? isSPACE(nextchr) : isSPACE_LC(nextchr))) sayNO; nextchr = UCHARAT(++locinput); break; - case NPRINTLUTF8: + case SPACELUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NPRINTUTF8: + case SPACEUTF8: if (!nextchr && locinput >= PL_regeol) sayNO; if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_print,(U8*)locinput)) + if (!(OP(scan) == SPACEUTF8 + ? swash_fetch(PL_utf8_space,(U8*)locinput) + : isSPACE_LC_utf8((U8*)locinput))) + { sayNO; + } locinput += PL_utf8skip[nextchr]; nextchr = UCHARAT(locinput); break; } - if (isPRINT(nextchr)) + if (!(OP(scan) == SPACEUTF8 + ? isSPACE(nextchr) : isSPACE_LC(nextchr))) sayNO; nextchr = UCHARAT(++locinput); break; - case PUNCTL: + case NSPACEL: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case PUNCT: + case NSPACE: if (!nextchr) sayNO; - if (!(OP(scan) == PUNCT - ? isPUNCT(nextchr) : isPUNCT_LC(nextchr))) + if (OP(scan) == SPACE + ? isSPACE(nextchr) : isSPACE_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; - case PUNCTLUTF8: + case NSPACELUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case PUNCTUTF8: + case NSPACEUTF8: if (!nextchr) sayNO; if (nextchr & 0x80) { - if (!(OP(scan) == PUNCTUTF8 - ? swash_fetch(PL_utf8_punct, (U8*)locinput) - : isPUNCT_LC_utf8((U8*)locinput))) + if (OP(scan) == NSPACEUTF8 + ? swash_fetch(PL_utf8_space,(U8*)locinput) + : isSPACE_LC_utf8((U8*)locinput)) { sayNO; } @@ -3217,60 +1985,32 @@ S_regmatch(pTHX_ regnode *prog) nextchr = UCHARAT(locinput); break; } - if (!(OP(scan) == PUNCTUTF8 - ? isPUNCT(nextchr) : isPUNCT_LC(nextchr))) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NPUNCTL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NPUNCT: - if (!nextchr) - sayNO; - if (OP(scan) == PUNCT - ? isPUNCT(nextchr) : isPUNCT_LC(nextchr)) + if (OP(scan) == NSPACEUTF8 + ? isSPACE(nextchr) : isSPACE_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; - case NPUNCTLUTF8: + case DIGITL: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NPUNCTUTF8: + case DIGIT: if (!nextchr && locinput >= PL_regeol) sayNO; - if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_punct,(U8*)locinput)) - sayNO; - locinput += PL_utf8skip[nextchr]; - nextchr = UCHARAT(locinput); - break; - } - if (isPUNCT(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case UPPERL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case UPPER: - if (!nextchr) - sayNO; - if (!(OP(scan) == UPPER - ? isUPPER(nextchr) : isUPPER_LC(nextchr))) + if (!(OP(scan) == DIGIT + ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))) sayNO; nextchr = UCHARAT(++locinput); break; - case UPPERLUTF8: + case DIGITLUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case UPPERUTF8: + case DIGITUTF8: if (!nextchr) sayNO; if (nextchr & 0x80) { - if (!(OP(scan) == UPPERUTF8 - ? swash_fetch(PL_utf8_upper, (U8*)locinput) - : isUPPER_LC_utf8((U8*)locinput))) + if (OP(scan) == NDIGITUTF8 + ? swash_fetch(PL_utf8_digit,(U8*)locinput) + : isDIGIT_LC_utf8((U8*)locinput)) { sayNO; } @@ -3278,50 +2018,35 @@ S_regmatch(pTHX_ regnode *prog) nextchr = UCHARAT(locinput); break; } - if (!(OP(scan) == UPPERUTF8 - ? isUPPER(nextchr) : isUPPER_LC(nextchr))) + if (!isDIGIT(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; - case NUPPERL: + case NDIGITL: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NUPPER: + case NDIGIT: if (!nextchr) sayNO; - if (OP(scan) == UPPER - ? isUPPER(nextchr) : isUPPER_LC(nextchr)) + if (OP(scan) == DIGIT + ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; - case NUPPERLUTF8: + case NDIGITLUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ - case NUPPERUTF8: + case NDIGITUTF8: if (!nextchr && locinput >= PL_regeol) sayNO; if (nextchr & 0x80) { - if (swash_fetch(PL_utf8_upper,(U8*)locinput)) + if (swash_fetch(PL_utf8_digit,(U8*)locinput)) sayNO; locinput += PL_utf8skip[nextchr]; nextchr = UCHARAT(locinput); break; } - if (isUPPER(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case XDIGIT: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (!isXDIGIT(nextchr)) - sayNO; - nextchr = UCHARAT(++locinput); - break; - case NXDIGIT: - if (!nextchr && locinput >= PL_regeol) - sayNO; - if (isXDIGIT(nextchr)) + if (isDIGIT(nextchr)) sayNO; nextchr = UCHARAT(++locinput); break; @@ -3433,7 +2158,6 @@ S_regmatch(pTHX_ regnode *prog) regexp *re; MAGIC *mg = Null(MAGIC*); re_cc_state state; - CURCUR cctmp; CHECKPOINT cp, lastcp; if(SvROK(ret) || SvRMAGICAL(ret)) { @@ -3476,9 +2200,7 @@ S_regmatch(pTHX_ regnode *prog) state.cc = PL_regcc; state.re = PL_reg_re; - cctmp.cur = 0; - cctmp.oldcc = 0; - PL_regcc = &cctmp; + PL_regcc = 0; cp = regcppush(0); /* Save *all* the positions. */ REGCP_SET; @@ -3492,15 +2214,24 @@ S_regmatch(pTHX_ regnode *prog) PL_reg_maxiter = 0; if (regmatch(re->program + 1)) { + /* Even though we succeeded, we need to restore + global variables, since we may be wrapped inside + SUSPEND, thus the match may be not finished yet. */ + + /* XXXX Do this only if SUSPENDed? */ + PL_reg_call_cc = state.prev; + PL_regcc = state.cc; + PL_reg_re = state.re; + cache_re(PL_reg_re); + + /* XXXX This is too dramatic a measure... */ + PL_reg_maxiter = 0; + + /* These are needed even if not SUSPEND. */ ReREFCNT_dec(re); regcpblow(cp); sayYES; } - DEBUG_r( - PerlIO_printf(Perl_debug_log, - "%*s failed...\n", - REPORT_CODE_OFF+PL_regindent*2, "") - ); ReREFCNT_dec(re); REGCP_UNWIND; regcppop(); @@ -3551,6 +2282,81 @@ S_regmatch(pTHX_ regnode *prog) case LOGICAL: logical = scan->flags; break; +/******************************************************************* + PL_regcc contains infoblock about the innermost (...)* loop, and + a pointer to the next outer infoblock. + + Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM): + + 1) After matching X, regnode for CURLYX is processed; + + 2) This regnode creates infoblock on the stack, and calls + regmatch() recursively with the starting point at WHILEM node; + + 3) Each hit of WHILEM node tries to match A and Z (in the order + depending on the current iteration, min/max of {min,max} and + greediness). The information about where are nodes for "A" + and "Z" is read from the infoblock, as is info on how many times "A" + was already matched, and greediness. + + 4) After A matches, the same WHILEM node is hit again. + + 5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX + of the same pair. Thus when WHILEM tries to match Z, it temporarily + resets PL_regcc, since this Y(A)*Z can be a part of some other loop: + as in (Y(A)*Z)*. If Z matches, the automaton will hit the WHILEM node + of the external loop. + + Currently present infoblocks form a tree with a stem formed by PL_curcc + and whatever it mentions via ->next, and additional attached trees + corresponding to temporarily unset infoblocks as in "5" above. + + In the following picture infoblocks for outer loop of + (Y(A)*?Z)*?T are denoted O, for inner I. NULL starting block + is denoted by x. The matched string is YAAZYAZT. Temporarily postponed + infoblocks are drawn below the "reset" infoblock. + + In fact in the picture below we do not show failed matches for Z and T + by WHILEM blocks. [We illustrate minimal matches, since for them it is + more obvious *why* one needs to *temporary* unset infoblocks.] + + Matched REx position InfoBlocks Comment + (Y(A)*?Z)*?T x + Y(A)*?Z)*?T x <- O + Y (A)*?Z)*?T x <- O + Y A)*?Z)*?T x <- O <- I + YA )*?Z)*?T x <- O <- I + YA A)*?Z)*?T x <- O <- I + YAA )*?Z)*?T x <- O <- I + YAA Z)*?T x <- O # Temporary unset I + I + + YAAZ Y(A)*?Z)*?T x <- O + I + + YAAZY (A)*?Z)*?T x <- O + I + + YAAZY A)*?Z)*?T x <- O <- I + I + + YAAZYA )*?Z)*?T x <- O <- I + I + + YAAZYA Z)*?T x <- O # Temporary unset I + I,I + + YAAZYAZ )*?T x <- O + I,I + + YAAZYAZ T x # Temporary unset O + O + I,I + + YAAZYAZT x + O + I,I + *******************************************************************/ case CURLYX: { CURCUR cc; CHECKPOINT cp = PL_savestack_ix; @@ -3603,7 +2409,8 @@ S_regmatch(pTHX_ regnode *prog) if (locinput == cc->lastloc && n >= cc->min) { PL_regcc = cc->oldcc; - ln = PL_regcc->cur; + if (PL_regcc) + ln = PL_regcc->cur; DEBUG_r( PerlIO_printf(Perl_debug_log, "%*s empty match detected, try continuation...\n", @@ -3611,12 +2418,8 @@ S_regmatch(pTHX_ regnode *prog) ); if (regmatch(cc->next)) sayYES; - DEBUG_r( - PerlIO_printf(Perl_debug_log, - "%*s failed...\n", - REPORT_CODE_OFF+PL_regindent*2, "") - ); - PL_regcc->cur = ln; + if (PL_regcc) + PL_regcc->cur = ln; PL_regcc = cc; sayNO; } @@ -3630,11 +2433,6 @@ S_regmatch(pTHX_ regnode *prog) sayYES; cc->cur = n - 1; cc->lastloc = lastloc; - DEBUG_r( - PerlIO_printf(Perl_debug_log, - "%*s failed...\n", - REPORT_CODE_OFF+PL_regindent*2, "") - ); sayNO; } @@ -3677,7 +2475,7 @@ S_regmatch(pTHX_ regnode *prog) "%*s already tried at this position...\n", REPORT_CODE_OFF+PL_regindent*2, "") ); - sayNO; + sayNO_SILENT; } PL_reg_poscache[o] |= (1<minmod) { PL_regcc = cc->oldcc; - ln = PL_regcc->cur; + if (PL_regcc) + ln = PL_regcc->cur; cp = regcppush(cc->parenfloor); REGCP_SET; if (regmatch(cc->next)) { @@ -3696,7 +2495,8 @@ S_regmatch(pTHX_ regnode *prog) } REGCP_UNWIND; regcppop(); - PL_regcc->cur = ln; + if (PL_regcc) + PL_regcc->cur = ln; PL_regcc = cc; if (n >= cc->max) { /* Maximum greed exceeded? */ @@ -3725,11 +2525,6 @@ S_regmatch(pTHX_ regnode *prog) regcpblow(cp); sayYES; } - DEBUG_r( - PerlIO_printf(Perl_debug_log, - "%*s failed...\n", - REPORT_CODE_OFF+PL_regindent*2, "") - ); REGCP_UNWIND; regcppop(); cc->cur = n - 1; @@ -3767,14 +2562,12 @@ S_regmatch(pTHX_ regnode *prog) /* Failed deeper matches of scan, so see if this one works. */ PL_regcc = cc->oldcc; - ln = PL_regcc->cur; + if (PL_regcc) + ln = PL_regcc->cur; if (regmatch(cc->next)) sayYES; - DEBUG_r( - PerlIO_printf(Perl_debug_log, "%*s failed...\n", - REPORT_CODE_OFF+PL_regindent*2, "") - ); - PL_regcc->cur = ln; + if (PL_regcc) + PL_regcc->cur = ln; PL_regcc = cc; cc->cur = n - 1; cc->lastloc = lastloc; @@ -3859,7 +2652,7 @@ S_regmatch(pTHX_ regnode *prog) ln = n; locinput = PL_reginput; if (PL_regkind[(U8)OP(next)] == EXACT) { - c1 = UCHARAT(OPERAND(next) + 1); + c1 = (U8)*STRING(next); if (OP(next) == EXACTF) c2 = PL_fold[c1]; else if (OP(next) == EXACTFL) @@ -3916,7 +2709,7 @@ S_regmatch(pTHX_ regnode *prog) ); if (n >= ln) { if (PL_regkind[(U8)OP(next)] == EXACT) { - c1 = UCHARAT(OPERAND(next) + 1); + c1 = (U8)*STRING(next); if (OP(next) == EXACTF) c2 = PL_fold[c1]; else if (OP(next) == EXACTFL) @@ -3993,7 +2786,7 @@ S_regmatch(pTHX_ regnode *prog) * when we know what character comes next. */ if (PL_regkind[(U8)OP(next)] == EXACT) { - c1 = UCHARAT(OPERAND(next) + 1); + c1 = (U8)*STRING(next); if (OP(next) == EXACTF) c2 = PL_fold[c1]; else if (OP(next) == EXACTFL) @@ -4167,14 +2960,22 @@ S_regmatch(pTHX_ regnode *prog) "%*s continuation failed...\n", REPORT_CODE_OFF+PL_regindent*2, "") ); - sayNO; + sayNO_SILENT; + } + if (locinput < PL_regtill) { + DEBUG_r(PerlIO_printf(Perl_debug_log, + "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n", + PL_colors[4], + (long)(locinput - PL_reg_starttry), + (long)(PL_regtill - PL_reg_starttry), + PL_colors[5])); + sayNO_FINAL; /* Cannot match: too short. */ } - if (locinput < PL_regtill) - sayNO; /* Cannot match: too short. */ - /* Fall through */ + PL_reginput = locinput; /* put where regtry can find it */ + sayYES_FINAL; /* Success! */ case SUCCEED: PL_reginput = locinput; /* put where regtry can find it */ - sayYES; /* Success! */ + sayYES_LOUD; /* Success! */ case SUSPEND: n = 1; PL_reginput = locinput; @@ -4250,7 +3051,7 @@ S_regmatch(pTHX_ regnode *prog) next = NULL; break; default: - PerlIO_printf(PerlIO_stderr(), "%lx %d\n", + PerlIO_printf(Perl_error_log, "%lx %d\n", (unsigned long)scan, OP(scan)); Perl_croak(aTHX_ "regexp memory corruption"); } @@ -4265,6 +3066,16 @@ S_regmatch(pTHX_ regnode *prog) /*NOTREACHED*/ sayNO; +yes_loud: + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s %scould match...%s\n", + REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5]) + ); + goto yes; +yes_final: + DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n", + PL_colors[4],PL_colors[5])); yes: #ifdef DEBUGGING PL_regindent--; @@ -4272,6 +3083,14 @@ yes: return 1; no: + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s %sfailed...%s\n", + REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5]) + ); + goto do_no; +no_final: +do_no: #ifdef DEBUGGING PL_regindent--; #endif @@ -4299,7 +3118,6 @@ S_regrepeat(pTHX_ regnode *p, I32 max) scan = PL_reginput; if (max != REG_INFTY && max < loceol - scan) loceol = scan + max; - opnd = (char *) OPERAND(p); switch (OP(p)) { case REG_ANY: while (scan < loceol && *scan != '\n') @@ -4323,19 +3141,19 @@ S_regrepeat(pTHX_ regnode *p, I32 max) } break; case EXACT: /* length of string is 1 */ - c = UCHARAT(++opnd); + c = (U8)*STRING(p); while (scan < loceol && UCHARAT(scan) == c) scan++; break; case EXACTF: /* length of string is 1 */ - c = UCHARAT(++opnd); + c = (U8)*STRING(p); while (scan < loceol && (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c])) scan++; break; case EXACTFL: /* length of string is 1 */ PL_reg_flags |= RF_tainted; - c = UCHARAT(++opnd); + c = (U8)*STRING(p); while (scan < loceol && (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c])) scan++; @@ -4348,6 +3166,7 @@ S_regrepeat(pTHX_ regnode *p, I32 max) } break; case ANYOF: + opnd = MASK(p); while (scan < loceol && REGINCLASS(opnd, *scan)) scan++; break;