X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=efdd8df7abe2b84d4a7e8312803837b008ae61eb;hb=52a55424e4624fc79eb8894fb91c5e2f4a9018ab;hp=d65d70c916d75068f2c775f15c75e00cc96ba824;hpb=8e5e9ebe73253381295c8c22fd24720255d732e9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/regexec.c b/regexec.c index d65d70c..efdd8df 100644 --- a/regexec.c +++ b/regexec.c @@ -131,15 +131,22 @@ /* for use after a quantifier and before an EXACT-like node -- japhy */ #define JUMPABLE(rn) ( \ OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \ - OP(rn) == SUSPEND || OP(rn) == IFMATCH \ + OP(rn) == SUSPEND || OP(rn) == IFMATCH || \ + OP(rn) == PLUS || OP(rn) == MINMOD || \ + (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \ ) -#define NEAR_EXACT(rn) (PL_regkind[(U8)OP(rn)] == EXACT || JUMPABLE(rn)) +#define HAS_TEXT(rn) ( \ + PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \ +) -#define NEXT_IMPT(rn) STMT_START { \ +#define FIND_NEXT_IMPT(rn) STMT_START { \ while (JUMPABLE(rn)) \ - if (OP(rn) == SUSPEND || OP(rn) == IFMATCH) \ + if (OP(rn) == SUSPEND || OP(rn) == IFMATCH || \ + PL_regkind[(U8)OP(rn)] == CURLY) \ rn = NEXTOPER(NEXTOPER(rn)); \ + else if (OP(rn) == PLUS) \ + rn = NEXTOPER(rn); \ else rn += NEXT_OFF(rn); \ } STMT_END @@ -383,26 +390,33 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *check_at = Nullch; /* check substr found at this pos */ #ifdef DEBUGGING char *i_strpos = strpos; + SV *dsv = PERL_DEBUG_PAD_ZERO(0); #endif - DEBUG_r( if (!PL_colorset) reginitcolors() ); - DEBUG_r(PerlIO_printf(Perl_debug_log, - "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n", - PL_colors[4],PL_colors[5],PL_colors[0], - prog->precomp, - PL_colors[1], - (strlen(prog->precomp) > 60 ? "..." : ""), - PL_colors[0], - (int)(strend - strpos > 60 ? 60 : strend - strpos), - strpos, PL_colors[1], - (strend - strpos > 60 ? "..." : "")) - ); + DEBUG_r({ + char*s = UTF ? sv_uni_display(dsv, sv, 60, 0) : strpos; + int len = UTF ? strlen(s) : strend - strpos; + if (!PL_colorset) + reginitcolors(); + PerlIO_printf(Perl_debug_log, + "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n", + PL_colors[4],PL_colors[5],PL_colors[0], + prog->precomp, + PL_colors[1], + (strlen(prog->precomp) > 60 ? "..." : ""), + PL_colors[0], + (int)(len > 60 ? 60 : len), + s, PL_colors[1], + (len > 60 ? "..." : "") + ); + }); if (prog->reganch & ROPT_UTF8) PL_reg_flags |= RF_utf8; if (prog->minlen > CHR_DIST((U8*)strend, (U8*)strpos)) { - DEBUG_r(PerlIO_printf(Perl_debug_log, "String too short...\n")); + DEBUG_r(PerlIO_printf(Perl_debug_log, + "String too short... [re_intuit_start]\n")); goto fail; } strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos; @@ -1450,6 +1464,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * char *scream_olds; SV* oreplsv = GvSV(PL_replgv); bool do_utf8 = DO_UTF8(sv); +#ifdef DEBUGGING + SV *dsv = PERL_DEBUG_PAD_ZERO(0); +#endif PL_regcc = 0; @@ -1465,11 +1482,10 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } minlen = prog->minlen; - if (do_utf8 && !(prog->reganch & ROPT_CANY_SEEN)) { - if (utf8_distance((U8*)strend, (U8*)startpos) < minlen) goto phooey; - } - else { - if (strend - startpos < minlen) goto phooey; + if (strend - startpos < minlen) { + DEBUG_r(PerlIO_printf(Perl_debug_log, + "String too short [regexec_flags]...\n")); + goto phooey; } /* Check validity of program. */ @@ -1528,22 +1544,29 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * d.scream_olds = &scream_olds; d.scream_pos = &scream_pos; s = re_intuit_start(prog, sv, s, strend, flags, &d); - if (!s) + if (!s) { + DEBUG_r(PerlIO_printf(Perl_debug_log, "Not present...\n")); goto phooey; /* not present */ + } } - DEBUG_r( if (!PL_colorset) reginitcolors() ); - DEBUG_r(PerlIO_printf(Perl_debug_log, - "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n", - PL_colors[4],PL_colors[5],PL_colors[0], - prog->precomp, - PL_colors[1], - (strlen(prog->precomp) > 60 ? "..." : ""), - PL_colors[0], - (int)(strend - startpos > 60 ? 60 : strend - startpos), - startpos, PL_colors[1], - (strend - startpos > 60 ? "..." : "")) - ); + DEBUG_r({ + char *s = do_utf8 ? sv_uni_display(dsv, sv, 60, 0) : startpos; + int len = do_utf8 ? strlen(s) : strend - startpos; + if (!PL_colorset) + reginitcolors(); + PerlIO_printf(Perl_debug_log, + "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n", + PL_colors[4],PL_colors[5],PL_colors[0], + prog->precomp, + PL_colors[1], + (strlen(prog->precomp) > 60 ? "..." : ""), + PL_colors[0], + (int)(len > 60 ? 60 : len), + s, PL_colors[1], + (len > 60 ? "..." : "") + ); + }); /* Simplest case: anchored match need be tried only once. */ /* [unless only anchor is BOL and multiline is set] */ @@ -1713,7 +1736,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * DEBUG_r({ SV *prop = sv_newmortal(); regprop(prop, c); - PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), s); + PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), UTF ? sv_uni_display(dsv, sv, 60, 0) : s); }); if (find_byclass(prog, c, s, strend, startpos, 0)) goto got_it; @@ -1920,6 +1943,12 @@ S_regtry(pTHX_ regexp *prog, char *startpos) New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*); } +#ifdef DEBUGGING + sv_setpvn(PERL_DEBUG_PAD(0), "", 0); + sv_setpvn(PERL_DEBUG_PAD(1), "", 0); + sv_setpvn(PERL_DEBUG_PAD(2), "", 0); +#endif + /* XXXX What this code is doing here?!!! There should be no need to do this again and again, PL_reglastparen should take care of this! --ilya*/ @@ -2026,6 +2055,11 @@ S_regmatch(pTHX_ regnode *prog) I32 firstcp = PL_savestack_ix; #endif register bool do_utf8 = PL_reg_match_utf8; +#ifdef DEBUGGING + SV *dsv0 = PERL_DEBUG_PAD_ZERO(0); + SV *dsv1 = PERL_DEBUG_PAD_ZERO(1); + SV *dsv2 = PERL_DEBUG_PAD_ZERO(2); +#endif #ifdef DEBUGGING PL_regindent++; @@ -2036,7 +2070,7 @@ S_regmatch(pTHX_ regnode *prog) scan = prog; while (scan != NULL) { - DEBUG_r( { + DEBUG_r( { SV *prop = sv_newmortal(); int docolor = *PL_colors[0]; int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */ @@ -2051,33 +2085,55 @@ S_regmatch(pTHX_ regnode *prog) ? (5 + taill) - l : locinput - PL_bostr; int pref0_len; - while (UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len))) + while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len))) pref_len++; 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); - while (UTF8_IS_CONTINUATION(*(U8*)(locinput + l))) + while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l))) l--; if (pref0_len < 0) pref0_len = 0; if (pref0_len > pref_len) pref0_len = pref_len; regprop(prop, scan); - PerlIO_printf(Perl_debug_log, - "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n", - (IV)(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, - "", - (IV)(scan - PL_regprogram), PL_regindent*2, "", - SvPVX(prop)); - } ); + { + char *s0 = + do_utf8 ? + pv_uni_display(dsv0, (U8*)(locinput - pref_len), + pref0_len, 60, 0) : + locinput - pref_len; + int len0 = do_utf8 ? strlen(s0) : pref0_len; + char *s1 = do_utf8 ? + pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len), + pref_len - pref0_len, 60, 0) : + locinput - pref_len + pref0_len; + int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len; + char *s2 = do_utf8 ? + pv_uni_display(dsv2, (U8*)locinput, + PL_regeol - locinput, 60, 0) : + locinput; + int len2 = do_utf8 ? strlen(s2) : l; + PerlIO_printf(Perl_debug_log, + "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n", + (IV)(locinput - PL_bostr), + PL_colors[4], + len0, s0, + PL_colors[5], + PL_colors[2], + len1, s1, + PL_colors[3], + (docolor ? "" : "> <"), + PL_colors[0], + len2, s2, + PL_colors[1], + 15 - l - pref_len + 1, + "", + (IV)(scan - PL_regprogram), PL_regindent*2, "", + SvPVX(prop)); + } + }); next = scan + NEXT_OFF(scan); if (next == scan) @@ -2161,31 +2217,40 @@ S_regmatch(pTHX_ regnode *prog) s = STRING(scan); ln = STR_LEN(scan); if (do_utf8 != (UTF!=0)) { + /* The target and the pattern have differing "utf8ness". */ char *l = locinput; char *e = s + ln; STRLEN len; - if (do_utf8) + + if (do_utf8) { + /* The target is utf8, the pattern is not utf8. */ while (s < e) { if (l >= PL_regeol) - sayNO; - if (*((U8*)s) != utf8_to_uvchr((U8*)l, &len)) - sayNO; - s++; + sayNO; + if (NATIVE_TO_UNI(*(U8*)s) != + utf8_to_uvchr((U8*)l, &len)) + sayNO; l += len; + s ++; } - else + } + else { + /* The target is not utf8, the pattern is utf8. */ while (s < e) { if (l >= PL_regeol) sayNO; - if (*((U8*)l) != utf8_to_uvchr((U8*)s, &len)) + if (NATIVE_TO_UNI(*((U8*)l)) != + utf8_to_uvchr((U8*)s, &len)) sayNO; s += len; - l++; + l ++; } + } locinput = l; nextchr = UCHARAT(locinput); break; } + /* The target and the pattern have the same "utf8ness". */ /* Inline the first character, for speed. */ if (UCHARAT(s) != nextchr) sayNO; @@ -2213,7 +2278,7 @@ S_regmatch(pTHX_ regnode *prog) if (l >= PL_regeol) sayNO; toLOWER_utf8((U8*)l, tmpbuf, &ulen); - if (memNE(s, tmpbuf, ulen)) + if (memNE(s, (char*)tmpbuf, ulen)) sayNO; s += UTF8SKIP(s); l += ulen; @@ -2487,7 +2552,7 @@ S_regmatch(pTHX_ regnode *prog) sayNO; toLOWER_utf8((U8*)s, tmpbuf1, &ulen1); toLOWER_utf8((U8*)l, tmpbuf2, &ulen2); - if (ulen1 != ulen2 || memNE(tmpbuf1, tmpbuf2, ulen1)) + if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1)) sayNO; s += ulen1; l += ulen2; @@ -3061,17 +3126,29 @@ S_regmatch(pTHX_ regnode *prog) if (ln && l == 0) n = ln; /* don't backtrack */ locinput = PL_reginput; - if (NEAR_EXACT(next)) { + if (HAS_TEXT(next) || JUMPABLE(next)) { regnode *text_node = next; - if (PL_regkind[(U8)OP(next)] != EXACT) - NEXT_IMPT(text_node); + if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); - if (PL_regkind[(U8)OP(text_node)] != EXACT) { - c1 = c2 = -1000; - } + if (! HAS_TEXT(text_node)) c1 = c2 = -1000; else { - c1 = (U8)*STRING(text_node); + if (PL_regkind[(U8)OP(text_node)] == REF) { + I32 n, ln; + n = ARG(text_node); /* which paren pair */ + ln = PL_regstartp[n]; + /* assume yes if we haven't seen CLOSEn */ + if ( + *PL_reglastparen < n || + ln == -1 || + ln == PL_regendp[n] + ) { + c1 = c2 = -1000; + goto assume_ok_MM; + } + c1 = *(PL_bostr + ln); + } + else { c1 = (U8)*STRING(text_node); } if (OP(next) == EXACTF) c2 = PL_fold[c1]; else if (OP(text_node) == EXACTFL) @@ -3082,6 +3159,7 @@ S_regmatch(pTHX_ regnode *prog) } else c1 = c2 = -1000; + assume_ok_MM: REGCP_SET(lastcp); /* This may be improved if l == 0. */ while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */ @@ -3130,17 +3208,30 @@ S_regmatch(pTHX_ regnode *prog) (IV) n, (IV)l) ); if (n >= ln) { - if (NEAR_EXACT(next)) { + if (HAS_TEXT(next) || JUMPABLE(next)) { regnode *text_node = next; - if (PL_regkind[(U8)OP(next)] != EXACT) - NEXT_IMPT(text_node); + if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); - if (PL_regkind[(U8)OP(text_node)] != EXACT) { - c1 = c2 = -1000; - } + if (! HAS_TEXT(text_node)) c1 = c2 = -1000; else { - c1 = (U8)*STRING(text_node); + if (PL_regkind[(U8)OP(text_node)] == REF) { + I32 n, ln; + n = ARG(text_node); /* which paren pair */ + ln = PL_regstartp[n]; + /* assume yes if we haven't seen CLOSEn */ + if ( + *PL_reglastparen < n || + ln == -1 || + ln == PL_regendp[n] + ) { + c1 = c2 = -1000; + goto assume_ok_REG; + } + c1 = *(PL_bostr + ln); + } + else { c1 = (U8)*STRING(text_node); } + if (OP(text_node) == EXACTF) c2 = PL_fold[c1]; else if (OP(text_node) == EXACTFL) @@ -3152,6 +3243,7 @@ S_regmatch(pTHX_ regnode *prog) else c1 = c2 = -1000; } + assume_ok_REG: REGCP_SET(lastcp); while (n >= ln) { /* If it could work, try it. */ @@ -3224,18 +3316,30 @@ S_regmatch(pTHX_ regnode *prog) * of the quantifier and the EXACT-like node. -- japhy */ - if (NEAR_EXACT(next)) { + if (HAS_TEXT(next) || JUMPABLE(next)) { U8 *s; regnode *text_node = next; - if (PL_regkind[(U8)OP(next)] != EXACT) - NEXT_IMPT(text_node); + if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); - if (PL_regkind[(U8)OP(text_node)] != EXACT) { - c1 = c2 = -1000; - } + if (! HAS_TEXT(text_node)) c1 = c2 = -1000; else { - s = (U8*)STRING(text_node); + if (PL_regkind[(U8)OP(text_node)] == REF) { + I32 n, ln; + n = ARG(text_node); /* which paren pair */ + ln = PL_regstartp[n]; + /* assume yes if we haven't seen CLOSEn */ + if ( + *PL_reglastparen < n || + ln == -1 || + ln == PL_regendp[n] + ) { + c1 = c2 = -1000; + goto assume_ok_easy; + } + s = (U8*)PL_bostr + ln; + } + else { s = (U8*)STRING(text_node); } if (!UTF) { c2 = c1 = *s; @@ -3264,6 +3368,7 @@ S_regmatch(pTHX_ regnode *prog) } else c1 = c2 = -1000; + assume_ok_easy: PL_reginput = locinput; if (minmod) { CHECKPOINT lastcp;