/* This is a const op added to hold the hints hash for
pp_entereval. The hash can be modified by the code
being eval'ed, so we return a copy instead. */
- XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)));
+ mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
else
/* Normal const. */
XPUSHs(cSVOP_sv);
The gv becomes a(nother) reference to the constant. */
SV *const value = SvRV(cv);
- SvUPGRADE((SV *)gv, SVt_RV);
+ SvUPGRADE((SV *)gv, SVt_IV);
SvPCS_IMPORTED_on(gv);
SvRV_set(gv, value);
SvREFCNT_inc_simple_void(value);
/* mg_get(right) may happen here ... */
rpv = SvPV_const(right, rlen);
rbyte = !DO_UTF8(right);
- right = sv_2mortal(newSVpvn(rpv, rlen));
+ right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */
rcopied = TRUE;
}
sv_utf8_upgrade_nomg(TARG);
else {
if (!rcopied)
- right = sv_2mortal(newSVpvn(rpv, rlen));
+ right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
sv_utf8_upgrade_nomg(right);
rpv = SvPV_const(right, rlen);
}
REGEXP * rx = PM_GETRE(pm);
SV * const pkg = CALLREG_PACKAGE(rx);
SV * const rv = sv_newmortal();
- SV * const sv = newSVrv(rv, SvPV_nolen(pkg));
- if (rx->extflags & RXf_TAINTED)
+
+ SvUPGRADE(rv, SVt_IV);
+ /* This RV is about to own a reference to the regexp. (In addition to the
+ reference already owned by the PMOP. */
+ ReREFCNT_inc(rx);
+ SvRV_set(rv, rx);
+ SvROK_on(rv);
+
+ if (pkg) {
+ HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+ (void)sv_bless(rv, stash);
+ }
+
+ if (RX_EXTFLAGS(rx) & RXf_TAINTED)
SvTAINTED_on(rv);
- sv_magic(sv,(SV*)ReREFCNT_inc(rx), PERL_MAGIC_qr,0,0);
XPUSHs(rv);
RETURN;
}
if (!s)
DIE(aTHX_ "panic: pp_match");
strend = s + len;
- rxtainted = ((rx->extflags & RXf_TAINTED) ||
+ rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
/* empty pattern special-cased to use last successful pattern if possible */
- if (!rx->prelen && PL_curpm) {
+ if (!RX_PRELEN(rx) && PL_curpm) {
pm = PL_curpm;
rx = PM_GETRE(pm);
}
- if (rx->minlen > (I32)len)
+ if (RX_MINLEN(rx) > (I32)len)
goto failure;
truebase = t = s;
/* XXXX What part of this is needed with true \G-support? */
if ((global = dynpm->op_pmflags & PMf_GLOBAL)) {
- rx->offs[0].start = -1;
+ RX_OFFS(rx)[0].start = -1;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (mg && mg->mg_len >= 0) {
- if (!(rx->extflags & RXf_GPOS_SEEN))
- rx->offs[0].end = rx->offs[0].start = mg->mg_len;
- else if (rx->extflags & RXf_ANCH_GPOS) {
+ if (!(RX_EXTFLAGS(rx) & RXf_GPOS_SEEN))
+ RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+ else if (RX_EXTFLAGS(rx) & RXf_ANCH_GPOS) {
r_flags |= REXEC_IGNOREPOS;
- rx->offs[0].end = rx->offs[0].start = mg->mg_len;
- } else if (rx->extflags & RXf_GPOS_FLOAT)
+ RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+ } else if (RX_EXTFLAGS(rx) & RXf_GPOS_FLOAT)
gpos = mg->mg_len;
else
- rx->offs[0].end = rx->offs[0].start = mg->mg_len;
- minmatch = (mg->mg_flags & MGf_MINMATCH) ? rx->gofs + 1 : 0;
+ RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+ minmatch = (mg->mg_flags & MGf_MINMATCH) ? RX_GOFS(rx) + 1 : 0;
update_minmatch = 0;
}
}
/g matches against large strings. So far a solution to this problem
appears to be quite tricky.
Test for the unsafe vars are TODO for now. */
- if (( !global && rx->nparens)
+ if (( !global && RX_NPARENS(rx))
|| SvTEMP(TARG) || PL_sawampersand ||
- (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
+ (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
r_flags |= REXEC_COPY_STR;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
play_it_again:
- if (global && rx->offs[0].start != -1) {
- t = s = rx->offs[0].end + truebase - rx->gofs;
- if ((s + rx->minlen) > strend || s < truebase)
+ if (global && RX_OFFS(rx)[0].start != -1) {
+ t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
+ if ((s + RX_MINLEN(rx)) > strend || s < truebase)
goto nope;
if (update_minmatch++)
minmatch = had_zerolen;
}
- if (rx->extflags & RXf_USE_INTUIT &&
- DO_UTF8(TARG) == ((rx->extflags & RXf_UTF8) != 0)) {
+ if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT &&
+ DO_UTF8(TARG) == ((RX_EXTFLAGS(rx) & RXf_UTF8) != 0)) {
/* FIXME - can PL_bostr be made const char *? */
PL_bostr = (char *)truebase;
s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
if (!s)
goto nope;
- if ( (rx->extflags & RXf_CHECK_ALL)
+ if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !PL_sawampersand
- && !(rx->extflags & RXf_PMf_KEEPCOPY)
- && ((rx->extflags & RXf_NOSCAN)
- || !((rx->extflags & RXf_INTUIT_TAIL)
+ && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
+ && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
+ || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
&& (r_flags & REXEC_SCREAM)))
&& !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */
goto yup;
RX_MATCH_TAINTED_on(rx);
TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
- const I32 nparens = rx->nparens;
+ const I32 nparens = RX_NPARENS(rx);
I32 i = (global && !nparens) ? 1 : 0;
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
- if ((rx->offs[i].start != -1) && rx->offs[i].end != -1 ) {
- const I32 len = rx->offs[i].end - rx->offs[i].start;
- s = rx->offs[i].start + truebase;
- if (rx->offs[i].end < 0 || rx->offs[i].start < 0 ||
+ if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) {
+ const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start;
+ s = RX_OFFS(rx)[i].start + truebase;
+ if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 ||
len < 0 || len > strend - s)
DIE(aTHX_ "panic: pp_match start/end pointers");
sv_setpvn(*SP, s, len);
mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
&PL_vtbl_mglob, NULL, 0);
}
- if (rx->offs[0].start != -1) {
- mg->mg_len = rx->offs[0].end;
- if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
+ if (RX_OFFS(rx)[0].start != -1) {
+ mg->mg_len = RX_OFFS(rx)[0].end;
+ if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
mg->mg_flags |= MGf_MINMATCH;
else
mg->mg_flags &= ~MGf_MINMATCH;
}
}
- had_zerolen = (rx->offs[0].start != -1
- && (rx->offs[0].start + rx->gofs
- == (UV)rx->offs[0].end));
+ had_zerolen = (RX_OFFS(rx)[0].start != -1
+ && (RX_OFFS(rx)[0].start + RX_GOFS(rx)
+ == (UV)RX_OFFS(rx)[0].end));
PUTBACK; /* EVAL blocks may use stack */
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
goto play_it_again;
mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
&PL_vtbl_mglob, NULL, 0);
}
- if (rx->offs[0].start != -1) {
- mg->mg_len = rx->offs[0].end;
- if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
+ if (RX_OFFS(rx)[0].start != -1) {
+ mg->mg_len = RX_OFFS(rx)[0].end;
+ if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
mg->mg_flags |= MGf_MINMATCH;
else
mg->mg_flags &= ~MGf_MINMATCH;
#endif
}
if (RX_MATCH_COPIED(rx))
- Safefree(rx->subbeg);
+ Safefree(RX_SUBBEG(rx));
RX_MATCH_COPIED_off(rx);
- rx->subbeg = NULL;
+ RX_SUBBEG(rx) = NULL;
if (global) {
/* FIXME - should rx->subbeg be const char *? */
- rx->subbeg = (char *) truebase;
- rx->offs[0].start = s - truebase;
+ RX_SUBBEG(rx) = (char *) truebase;
+ RX_OFFS(rx)[0].start = s - truebase;
if (RX_MATCH_UTF8(rx)) {
- char * const t = (char*)utf8_hop((U8*)s, rx->minlenret);
- rx->offs[0].end = t - truebase;
+ char * const t = (char*)utf8_hop((U8*)s, RX_MINLENRET(rx));
+ RX_OFFS(rx)[0].end = t - truebase;
}
else {
- rx->offs[0].end = s - truebase + rx->minlenret;
+ RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
}
- rx->sublen = strend - truebase;
+ RX_SUBLEN(rx) = strend - truebase;
goto gotcha;
}
- if (PL_sawampersand || rx->extflags & RXf_PMf_KEEPCOPY) {
+ if (PL_sawampersand || RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) {
I32 off;
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
(int) SvTYPE(TARG), (void*)truebase, (void*)t,
(int)(t-truebase));
}
- rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
- rx->subbeg = (char *) SvPVX_const(rx->saved_copy) + (t - truebase);
- assert (SvPOKp(rx->saved_copy));
+ RX_SAVED_COPY(rx) = sv_setsv_cow(RX_SAVED_COPY(rx), TARG);
+ RX_SUBBEG(rx)
+ = (char *) SvPVX_const(RX_SAVED_COPY(rx)) + (t - truebase);
+ assert (SvPOKp(RX_SAVED_COPY(rx)));
} else
#endif
{
- rx->subbeg = savepvn(t, strend - t);
+ RX_SUBBEG(rx) = savepvn(t, strend - t);
#ifdef PERL_OLD_COPY_ON_WRITE
- rx->saved_copy = NULL;
+ RX_SAVED_COPY(rx) = NULL;
#endif
}
- rx->sublen = strend - t;
+ RX_SUBLEN(rx) = strend - t;
RX_MATCH_COPIED_on(rx);
- off = rx->offs[0].start = s - t;
- rx->offs[0].end = off + rx->minlenret;
+ off = RX_OFFS(rx)[0].start = s - t;
+ RX_OFFS(rx)[0].end = off + RX_MINLENRET(rx);
}
else { /* startp/endp are used by @- @+. */
- rx->offs[0].start = s - truebase;
- rx->offs[0].end = s - truebase + rx->minlenret;
+ RX_OFFS(rx)[0].start = s - truebase;
+ RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
}
- /* including rx->nparens in the below code seems highly suspicious.
+ /* including RX_NPARENS(rx) in the below code seems highly suspicious.
-dmq */
- rx->nparens = rx->lastparen = rx->lastcloseparen = 0; /* used by @-, @+, and $^N */
+ RX_NPARENS(rx) = RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0; /* used by @-, @+, and $^N */
LEAVE_SCOPE(oldsave);
RETPUSHYES;
const I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
+ I32 matched;
#ifdef PERL_OLD_COPY_ON_WRITE
bool is_cow;
#endif
s = SvPV_mutable(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
- rxtainted = ((rx->extflags & RXf_TAINTED) ||
+ rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
if (PL_tainted)
rxtainted |= 2;
position, once with zero-length,
second time with non-zero. */
- if (!rx->prelen && PL_curpm) {
+ if (!RX_PRELEN(rx) && PL_curpm) {
pm = PL_curpm;
rx = PM_GETRE(pm);
}
- r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand
- || (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
+ r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand
+ || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
? REXEC_COPY_STR : 0;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
orig = m = s;
- if (rx->extflags & RXf_USE_INTUIT) {
+ if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
PL_bostr = orig;
s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
if (!s)
goto nope;
/* How to do it in subst? */
-/* if ( (rx->extflags & RXf_CHECK_ALL)
+/* if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !PL_sawampersand
- && !(rx->extflags & RXf_KEEPCOPY)
- && ((rx->extflags & RXf_NOSCAN)
- || !((rx->extflags & RXf_INTUIT_TAIL)
+ && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY)
+ && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
+ || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
&& (r_flags & REXEC_SCREAM))))
goto yup;
*/
/* only replace once? */
once = !(rpm->op_pmflags & PMf_GLOBAL);
-
+ matched = CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
+ r_flags | REXEC_CHECKED);
/* known replacement string? */
if (dstr) {
/* replacement needing upgrading? */
#ifdef PERL_OLD_COPY_ON_WRITE
&& !is_cow
#endif
- && (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR))
- && !(rx->extflags & RXf_LOOKBEHIND_SEEN)
+ && (I32)clen <= RX_MINLENRET(rx) && (once || !(r_flags & REXEC_COPY_STR))
+ && !(RX_EXTFLAGS(rx) & RXf_LOOKBEHIND_SEEN)
&& (!doutf8 || SvUTF8(TARG))) {
- if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
- r_flags | REXEC_CHECKED))
+ if (!matched)
{
SPAGAIN;
PUSHs(&PL_sv_no);
SvSCREAM_off(TARG); /* disable possible screamer */
if (once) {
rxtainted |= RX_MATCH_TAINTED(rx);
- m = orig + rx->offs[0].start;
- d = orig + rx->offs[0].end;
+ 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 */
if (clen) {
else if ((i = m - s)) { /* faster from front */
d -= clen;
m = d;
+ Move(s, d - i, i, char);
sv_chop(TARG, d-i);
- s += i;
- while (i--)
- *--d = *--s;
if (clen)
Copy(c, m, clen, char);
}
if (iters++ > maxiters)
DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
- m = rx->offs[0].start + orig;
+ m = RX_OFFS(rx)[0].start + orig;
if ((i = m - s)) {
if (s != d)
Move(s, d, i, char);
Copy(c, d, clen, char);
d += clen;
}
- s = rx->offs[0].end + orig;
+ s = RX_OFFS(rx)[0].end + orig;
} while (CALLREGEXEC(rx, s, strend, orig, s == m,
TARG, NULL,
/* don't match same null twice */
}
TAINT_IF(rxtainted & 1);
SPAGAIN;
- PUSHs(sv_2mortal(newSViv((I32)iters)));
+ mPUSHi((I32)iters);
}
(void)SvPOK_only_UTF8(TARG);
TAINT_IF(rxtainted);
RETURN;
}
- if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
- r_flags | REXEC_CHECKED))
+ if (matched)
{
if (force_on_match) {
force_on_match = 0;
have_a_cow:
#endif
rxtainted |= RX_MATCH_TAINTED(rx);
- dstr = newSVpvn(m, s-m);
+ dstr = newSVpvn_utf8(m, s-m, DO_UTF8(TARG));
SAVEFREESV(dstr);
- if (DO_UTF8(TARG))
- SvUTF8_on(dstr);
PL_curpm = pm;
if (!c) {
register PERL_CONTEXT *cx;
if (iters++ > maxiters)
DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
- if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+ if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
m = s;
s = orig;
- orig = rx->subbeg;
+ orig = RX_SUBBEG(rx);
s = orig + (m - s);
strend = s + (strend - m);
}
- m = rx->offs[0].start + orig;
+ m = RX_OFFS(rx)[0].start + orig;
if (doutf8 && !SvUTF8(dstr))
sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
else
sv_catpvn(dstr, s, m-s);
- s = rx->offs[0].end + orig;
+ s = RX_OFFS(rx)[0].end + orig;
if (clen)
sv_catpvn(dstr, c, clen);
if (once)
TAINT_IF(rxtainted & 1);
SPAGAIN;
- PUSHs(sv_2mortal(newSViv((I32)iters)));
+ mPUSHi((I32)iters);
(void)SvPOK_only(TARG);
if (doutf8)
if (!SvOK(sv)) {
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
- if (SvTYPE(sv) < SVt_RV || SvTYPE(sv) == SVt_NV)
- sv_upgrade(sv, SVt_RV);
- else if (SvTYPE(sv) >= SVt_PV) {
- SvPV_free(sv);
- SvLEN_set(sv, 0);
- SvCUR_set(sv, 0);
- }
+ prepare_SV_for_RV(sv);
switch (to_what) {
case OPpDEREF_SV:
SvRV_set(sv, newSV(0));
projects / p5sagit/p5-mst-13.2.git / blobdiff