X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=6d0cf8dae28cce7a7d41de7a8d653bb868205a96;hb=f61d411c4d3cff1213d879acac3d5b738473d376;hp=b590f0e20cfa8e8898e7edf740d0c1297cf5ead5;hpb=9661b5442a5f8dacc64d54eb1de98575f21de5f2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/regexec.c b/regexec.c index b590f0e..6d0cf8d 100644 --- a/regexec.c +++ b/regexec.c @@ -37,6 +37,7 @@ # define Perl_regprop my_regprop /* *These* symbols are masked to allow static link. */ # define Perl_pregexec my_pregexec +# define Perl_reginitcolors my_reginitcolors #endif /*SUPPRESS 112*/ @@ -263,10 +264,12 @@ cache_re(regexp *prog) STATIC void restore_pos(void *arg) -{ +{ + dTHR; if (PL_reg_eval_set) { PL_reg_magic->mg_len = PL_reg_oldpos; PL_reg_eval_set = 0; + PL_curpm = PL_reg_oldcurpm; } } @@ -326,7 +329,7 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, /* Check validity of program. */ if (UCHARAT(prog->program) != REG_MAGIC) { - FAIL("corrupted regexp program"); + croak("corrupted regexp program"); } PL_reg_flags = 0; @@ -400,8 +403,8 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, s = startpos; } - DEBUG_r( - PerlIO_printf(Perl_debug_log, + DEBUG_r(if (!PL_colorset) reginitcolors()); + DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n", PL_colors[4],PL_colors[5],PL_colors[0], prog->precomp, @@ -415,12 +418,12 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, if (prog->reganch & ROPT_GPOS_SEEN) { MAGIC *mg; - int pos = 0; - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) - && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) - pos = mg->mg_len; - PL_reg_ganch = startpos + pos; + 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 + PL_reg_ganch = startpos; } /* Simplest case: anchored match need be tried only once. */ @@ -1008,14 +1011,15 @@ got_it: } } } - /* 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. */ - } - if (PL_reg_eval_set) + 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(0); + } + return 1; phooey: @@ -1054,9 +1058,10 @@ regtry(regexp *prog, char *startpos) if (PL_reg_sv) { /* Make $_ available to executed code. */ - if (PL_reg_sv != GvSV(PL_defgv)) { - SAVESPTR(GvSV(PL_defgv)); - GvSV(PL_defgv) = PL_reg_sv; + 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) @@ -1070,13 +1075,22 @@ regtry(regexp *prog, char *startpos) PL_reg_oldpos = mg->mg_len; SAVEDESTRUCTOR(restore_pos, 0); } + if (!PL_reg_curpm) + New(22,PL_reg_curpm, 1, PMOP); + PL_reg_curpm->op_pmregexp = prog; + PL_reg_oldcurpm = PL_curpm; + PL_curpm = PL_reg_curpm; + prog->subbeg = PL_bostr; + prog->subend = PL_regeol; /* strend may have been modified */ } + prog->startp[0] = startpos; PL_reginput = startpos; PL_regstartp = prog->startp; PL_regendp = prog->endp; PL_reglastparen = &prog->lastparen; prog->lastparen = 0; PL_regsize = 0; + DEBUG_r(PL_reg_starttry = startpos); if (PL_reg_start_tmpl <= prog->nparens) { PL_reg_start_tmpl = prog->nparens*3/2 + 3; if(PL_reg_start_tmp) @@ -1085,17 +1099,19 @@ regtry(regexp *prog, char *startpos) New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*); } + /* 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! */ sp = prog->startp; ep = prog->endp; if (prog->nparens) { - for (i = prog->nparens; i >= 0; i--) { - *sp++ = NULL; - *ep++ = NULL; + for (i = prog->nparens; i >= 1; i--) { + *++sp = NULL; + *++ep = NULL; } } REGCP_SET; if (regmatch(prog->program + 1)) { - prog->startp[0] = startpos; prog->endp[0] = PL_reginput; return 1; } @@ -1156,15 +1172,23 @@ regmatch(regnode *prog) 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_reginput); + 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", @@ -1640,8 +1664,9 @@ regmatch(regnode *prog) n = ARG(scan); PL_op = (OP_4tree*)PL_regdata->data[n]; DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) ); - PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]); + PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]); PL_reg_magic->mg_len = locinput - PL_bostr; + PL_regendp[0] = locinput; CALLRUNOPS(); /* Scalar context. */ SPAGAIN; @@ -2179,6 +2204,50 @@ regmatch(regnode *prog) sayNO; locinput = PL_reginput; REGCP_SET; + if (c1 != -1000) { + char *e = locinput + n - ln; /* Should not check after this */ + char *old = locinput; + + if (e >= PL_regeol || (n == REG_INFTY)) + e = PL_regeol - 1; + while (1) { + /* Find place 'next' could work */ + if (c1 == c2) { + while (locinput <= e && *locinput != c1) + locinput++; + } else { + while (locinput <= e + && *locinput != c1 + && *locinput != c2) + locinput++; + } + if (locinput > e) + sayNO; + /* PL_reginput == old now */ + if (locinput != old) { + ln = 1; /* Did some */ + if (regrepeat(scan, locinput - old) < + locinput - old) + sayNO; + } + /* PL_reginput == locinput now */ + if (paren) { + if (ln) { + PL_regstartp[paren] = HOPc(locinput, -1); + PL_regendp[paren] = locinput; + } + else + PL_regendp[paren] = NULL; + } + if (regmatch(next)) + sayYES; + PL_reginput = locinput; /* Could be reset... */ + REGCP_UNWIND; + /* Couldn't or didn't -- move forward. */ + old = locinput++; + } + } + else while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */ /* If it could work, try it. */ if (c1 == -1000 || @@ -2306,10 +2375,20 @@ regmatch(regnode *prog) case UNLESSM: n = 0; if (scan->flags) { - s = HOPMAYBEc(locinput, -scan->flags); - if (!s) - goto say_yes; - PL_reginput = s; + if (UTF) { /* XXXX This is absolutely + broken, we read before + start of string. */ + s = HOPMAYBEc(locinput, -scan->flags); + if (!s) + goto say_yes; + PL_reginput = s; + } + else { + if (locinput < PL_bostr + scan->flags) + goto say_yes; + PL_reginput = locinput - scan->flags; + goto do_ifmatch; + } } else PL_reginput = locinput; @@ -2317,10 +2396,20 @@ regmatch(regnode *prog) case IFMATCH: n = 1; if (scan->flags) { - s = HOPMAYBEc(locinput, -scan->flags); - if (!s || s < PL_bostr) - goto say_no; - PL_reginput = s; + if (UTF) { /* XXXX This is absolutely + broken, we read before + start of string. */ + s = HOPMAYBEc(locinput, -scan->flags); + if (!s || s < PL_bostr) + goto say_no; + PL_reginput = s; + } + else { + if (locinput < PL_bostr + scan->flags) + goto say_no; + PL_reginput = locinput - scan->flags; + goto do_ifmatch; + } } else PL_reginput = locinput; @@ -2356,7 +2445,7 @@ regmatch(regnode *prog) default: PerlIO_printf(PerlIO_stderr(), "%lx %d\n", (unsigned long)scan, OP(scan)); - FAIL("regexp memory corruption"); + croak("regexp memory corruption"); } scan = next; } @@ -2365,7 +2454,7 @@ regmatch(regnode *prog) * We get here only if there's trouble -- normally "case END" is * the terminating point. */ - FAIL("corrupted regexp pointers"); + croak("corrupted regexp pointers"); /*NOTREACHED*/ sayNO; @@ -2652,7 +2741,7 @@ regrepeat_hard(regnode *p, I32 max, I32 *lp) } /* - - regclass - determine if a character falls into a character class + - reginclass - determine if a character falls into a character class */ STATIC bool