STRLEN len;
const I32 oldsave = PL_savestack_ix;
I32 had_zerolen = 0;
+ MAGIC *mg = NULL;
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
/* get pos() if //g */
if (global) {
- MAGIC * const mg = mg_find_mglob(TARG);
+ mg = mg_find_mglob(TARG);
if (mg && mg->mg_len >= 0) {
curpos = mg->mg_len;
/* last time pos() was set, it was zero-length match */
if ( RX_NPARENS(rx)
|| PL_sawampersand
|| (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
+ || (dynpm->op_pmflags & PMf_KEEPCOPY)
)
#endif
{
if (! (global && gimme == G_ARRAY))
r_flags |= REXEC_COPY_SKIP_POST;
};
+#ifdef PERL_SAWAMPERSAND
+ if (dynpm->op_pmflags & PMf_KEEPCOPY)
+ /* handle KEEPCOPY in pmop but not rx, eg $r=qr/a/; /$r/p */
+ r_flags &= ~(REXEC_COPY_SKIP_PRE|REXEC_COPY_SKIP_POST);
+#endif
s = truebase;
play_it_again:
- if (global) {
+ if (global)
s = truebase + curpos;
- }
if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase,
had_zerolen, TARG, NULL, r_flags))
goto nope;
PL_curpm = pm;
- if (dynpm->op_pmflags & PMf_ONCE) {
+ if (dynpm->op_pmflags & PMf_ONCE)
#ifdef USE_ITHREADS
SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
#else
dynpm->op_pmflags |= PMf_USED;
#endif
- }
if (rxtainted)
RX_MATCH_TAINTED_on(rx);
/* update pos */
if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
- MAGIC *mg = mg_find_mglob(TARG);
- if (!mg) {
+ if (!mg)
mg = sv_magicext_mglob(TARG);
- }
- assert(RX_OFFS(rx)[0].start != -1); /* XXX get rid of next line? */
- if (RX_OFFS(rx)[0].start != -1) {
- mg->mg_len = RX_OFFS(rx)[0].end;
- if (RX_ZERO_LEN(rx))
- mg->mg_flags |= MGf_MINMATCH;
- else
- mg->mg_flags &= ~MGf_MINMATCH;
- }
+ mg->mg_len = RX_OFFS(rx)[0].end;
+ if (RX_ZERO_LEN(rx))
+ mg->mg_flags |= MGf_MINMATCH;
+ else
+ mg->mg_flags &= ~MGf_MINMATCH;
}
if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) {
nope:
if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
- MAGIC* const mg = mg_find_mglob(TARG);
- if (mg)
- mg->mg_len = -1;
+ if (!mg)
+ mg = mg_find_mglob(TARG);
+ if (mg)
+ mg->mg_len = -1;
}
LEAVE_SCOPE(oldsave);
if (gimme == G_ARRAY)
PMOP *rpm = pm;
char *s;
char *strend;
- char *m;
const char *c;
STRLEN clen;
I32 iters = 0;
I32 maxiters;
- I32 i;
bool once;
U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits.
See "how taint works" above */
r_flags = ( RX_NPARENS(rx)
|| PL_sawampersand
|| (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
+ || (rpm->op_pmflags & PMf_KEEPCOPY)
)
? REXEC_COPY_STR
: 0;
r_flags = REXEC_COPY_STR;
#endif
- m = s = orig;
-
- if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags))
+ if (!CALLREGEXEC(rx, orig, strend, orig, 0, TARG, NULL, r_flags))
{
SPAGAIN;
PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
LEAVE_SCOPE(oldsave);
RETURN;
}
- s = RX_OFFS(rx)[0].start + orig;
-
PL_curpm = pm;
/* known replacement string? */
}
if (once) {
- char *d;
+ char *d, *m;
if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
rxtainted |= SUBST_TAINT_PAT;
m = orig + RX_OFFS(rx)[0].start;
d = orig + RX_OFFS(rx)[0].end;
s = orig;
if (m - s > strend - d) { /* faster to shorten from end */
+ I32 i;
if (clen) {
Copy(c, m, clen, char);
m += clen;
*m = '\0';
SvCUR_set(TARG, m - s);
}
- else if ((i = m - s)) { /* faster from front */
+ else { /* faster from front */
+ I32 i = m - s;
d -= clen;
- m = d;
- Move(s, d - i, i, char);
+ if (i > 0)
+ Move(s, d - i, i, char);
sv_chop(TARG, d-i);
if (clen)
- Copy(c, m, clen, char);
- }
- else if (clen) {
- d -= clen;
- sv_chop(TARG, d);
- Copy(c, d, clen, char);
- }
- else {
- sv_chop(TARG, d);
+ Copy(c, d, clen, char);
}
SPAGAIN;
PUSHs(&PL_sv_yes);
}
else {
- char *d = s;
+ char *d, *m;
+ d = s = RX_OFFS(rx)[0].start + orig;
do {
+ I32 i;
if (iters++ > maxiters)
DIE(aTHX_ "Substitution loop");
if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
} while (CALLREGEXEC(rx, s, strend, orig, s == m,
TARG, NULL,
/* don't match same null twice */
- REXEC_NOT_FIRST|REXEC_IGNOREPOS));
+ REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW));
if (s != d) {
- i = strend - s;
+ I32 i = strend - s;
SvCUR_set(TARG, d - SvPVX_const(TARG) + i);
Move(s, d, i+1, char); /* include the NUL */
}
}
else {
bool first;
+ char *m;
SV *repl;
if (force_on_match) {
/* redo the first match, this time with the orig var
if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
rxtainted |= SUBST_TAINT_PAT;
repl = dstr;
- dstr = newSVpvn_flags(m, s-m, SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
+ s = RX_OFFS(rx)[0].start + orig;
+ dstr = newSVpvn_flags(orig, s-orig,
+ SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
if (!c) {
PERL_CONTEXT *cx;
SPAGAIN;
+ m = orig;
/* note that a whole bunch of local vars are saved here for
* use by pp_substcont: here's a list of them in case you're
* searching for places in this sub that uses a particular var:
PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot);
}
- r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
first = TRUE;
do {
if (iters++ > maxiters)
if (RX_MATCH_TAINTED(rx))
rxtainted |= SUBST_TAINT_PAT;
if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
- m = s;
- s = orig;
+ char *old_s = s;
+ char *old_orig = orig;
assert(RX_SUBOFFSET(rx) == 0);
+
orig = RX_SUBBEG(rx);
- s = orig + (m - s);
- strend = s + (strend - m);
+ s = orig + (old_s - old_orig);
+ strend = s + (strend - old_s);
}
m = RX_OFFS(rx)[0].start + orig;
sv_catpvn_nomg_maybeutf8(dstr, s, m - s, DO_UTF8(TARG));
if (once)
break;
} while (CALLREGEXEC(rx, s, strend, orig, s == m,
- TARG, NULL, r_flags));
+ TARG, NULL,
+ REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW));
sv_catpvn_nomg_maybeutf8(dstr, s, strend - s, DO_UTF8(TARG));
if (rpm->op_pmflags & PMf_NONDESTRUCT) {
https://perl5.git.perl.org / perl5.git / blobdiff