dSP;
PMOP * const pm = cPMOP;
REGEXP * rx = PM_GETRE(pm);
- SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
+ regexp *prog = ReANY(rx);
+ SV * const pkg = RXp_ENGINE(prog)->qr_package(aTHX_ (rx));
SV * const rv = sv_newmortal();
CV **cvp;
CV *cv;
(void)sv_bless(rv, stash);
}
- if (UNLIKELY(RX_ISTAINTED(rx))) {
+ if (UNLIKELY(RXp_ISTAINTED(prog))) {
SvTAINTED_on(rv);
SvTAINTED_on(SvRV(rv));
}
U8 r_flags = 0;
const char *truebase; /* Start of string */
REGEXP *rx = PM_GETRE(pm);
+ regexp *prog = ReANY(rx);
bool rxtainted;
const U8 gimme = GIMME_V;
STRLEN len;
PUTBACK; /* EVAL blocks need stack_sp. */
/* Skip get-magic if this is a qr// clone, because regcomp has
already done it. */
- truebase = ReANY(rx)->mother_re
+ truebase = prog->mother_re
? SvPV_nomg_const(TARG, len)
: SvPV_const(TARG, len);
if (!truebase)
DIE(aTHX_ "panic: pp_match");
strend = truebase + len;
- rxtainted = (RX_ISTAINTED(rx) ||
+ rxtainted = (RXp_ISTAINTED(prog) ||
(TAINT_get && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
}
/* handle the empty pattern */
- if (!RX_PRELEN(rx) && PL_curpm && !ReANY(rx)->mother_re) {
+ if (!RX_PRELEN(rx) && PL_curpm && !prog->mother_re) {
if (PL_curpm == PL_reg_curpm) {
if (PL_curpm_under) {
if (PL_curpm_under == PL_reg_curpm) {
pm = PL_curpm;
}
rx = PM_GETRE(pm);
+ prog = ReANY(rx);
}
- if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
+ if (RXp_MINLEN(prog) >= 0 && (STRLEN)RXp_MINLEN(prog) > len) {
DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
UVuf " < %" IVdf ")\n",
- (UV)len, (IV)RX_MINLEN(rx)));
+ (UV)len, (IV)RXp_MINLEN(prog)));
goto nope;
}
}
#ifdef PERL_SAWAMPERSAND
- if ( RX_NPARENS(rx)
+ if ( RXp_NPARENS(prog)
|| PL_sawampersand
- || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
+ || (RXp_EXTFLAGS(prog) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
|| (dynpm->op_pmflags & PMf_KEEPCOPY)
)
#endif
#endif
if (rxtainted)
- RX_MATCH_TAINTED_on(rx);
- TAINT_IF(RX_MATCH_TAINTED(rx));
+ RXp_MATCH_TAINTED_on(prog);
+ TAINT_IF(RXp_MATCH_TAINTED(prog));
/* update pos */
if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
if (!mg)
mg = sv_magicext_mglob(TARG);
- MgBYTEPOS_set(mg, TARG, truebase, RX_OFFS(rx)[0].end);
- if (RX_ZERO_LEN(rx))
+ MgBYTEPOS_set(mg, TARG, truebase, RXp_OFFS(prog)[0].end);
+ if (RXp_ZERO_LEN(prog))
mg->mg_flags |= MGf_MINMATCH;
else
mg->mg_flags &= ~MGf_MINMATCH;
}
- if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) {
+ if ((!RXp_NPARENS(prog) && !global) || gimme != G_ARRAY) {
LEAVE_SCOPE(oldsave);
RETPUSHYES;
}
/* push captures on stack */
{
- const I32 nparens = RX_NPARENS(rx);
+ const I32 nparens = RXp_NPARENS(prog);
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 (LIKELY((RX_OFFS(rx)[i].start != -1)
- && RX_OFFS(rx)[i].end != -1 ))
+ if (LIKELY((RXp_OFFS(prog)[i].start != -1)
+ && RXp_OFFS(prog)[i].end != -1 ))
{
- const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start;
- const char * const s = RX_OFFS(rx)[i].start + truebase;
- if (UNLIKELY(RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0
- || len < 0 || len > strend - s))
+ const I32 len = RXp_OFFS(prog)[i].end - RXp_OFFS(prog)[i].start;
+ const char * const s = RXp_OFFS(prog)[i].start + truebase;
+ if (UNLIKELY( RXp_OFFS(prog)[i].end < 0
+ || RXp_OFFS(prog)[i].start < 0
+ || len < 0
+ || len > strend - s)
+ )
DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, "
"start=%ld, end=%ld, s=%p, strend=%p, len=%" UVuf,
- (long) i, (long) RX_OFFS(rx)[i].start,
- (long)RX_OFFS(rx)[i].end, s, strend, (UV) len);
+ (long) i, (long) RXp_OFFS(prog)[i].start,
+ (long)RXp_OFFS(prog)[i].end, s, strend, (UV) len);
sv_setpvn(*SP, s, len);
if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
SvUTF8_on(*SP);
}
}
if (global) {
- curpos = (UV)RX_OFFS(rx)[0].end;
- had_zerolen = RX_ZERO_LEN(rx);
+ curpos = (UV)RXp_OFFS(prog)[0].end;
+ had_zerolen = RXp_ZERO_LEN(prog);
PUTBACK; /* EVAL blocks may use stack */
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
goto play_it_again;
char *orig;
U8 r_flags;
REGEXP *rx = PM_GETRE(pm);
+ regexp *prog = ReANY(rx);
STRLEN len;
int force_on_match = 0;
const I32 oldsave = PL_savestack_ix;
if (TAINTING_get) {
rxtainted = (
(SvTAINTED(TARG) ? SUBST_TAINT_STR : 0)
- | (RX_ISTAINTED(rx) ? SUBST_TAINT_PAT : 0)
+ | (RXp_ISTAINTED(prog) ? SUBST_TAINT_PAT : 0)
| ((pm->op_pmflags & PMf_RETAINT) ? SUBST_TAINT_RETAINT : 0)
| ((once && !(rpm->op_pmflags & PMf_NONDESTRUCT))
? SUBST_TAINT_BOOLRET : 0));
second time with non-zero. */
/* handle the empty pattern */
- if (!RX_PRELEN(rx) && PL_curpm && !ReANY(rx)->mother_re) {
+ if (!RX_PRELEN(rx) && PL_curpm && !prog->mother_re) {
if (PL_curpm == PL_reg_curpm) {
if (PL_curpm_under) {
if (PL_curpm_under == PL_reg_curpm) {
pm = PL_curpm;
}
rx = PM_GETRE(pm);
+ prog = ReANY(rx);
}
#ifdef PERL_SAWAMPERSAND
- r_flags = ( RX_NPARENS(rx)
+ r_flags = ( RXp_NPARENS(prog)
|| PL_sawampersand
- || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
+ || (RXp_EXTFLAGS(prog) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
|| (rpm->op_pmflags & PMf_KEEPCOPY)
)
? REXEC_COPY_STR
#ifdef PERL_ANY_COW
&& !was_cow
#endif
- && (I32)clen <= RX_MINLENRET(rx)
+ && (I32)clen <= RXp_MINLENRET(prog)
&& ( once
|| !(r_flags & REXEC_COPY_STR)
- || (!SvGMAGICAL(dstr) && !(RX_EXTFLAGS(rx) & RXf_EVAL_SEEN))
+ || (!SvGMAGICAL(dstr) && !(RXp_EXTFLAGS(prog) & RXf_EVAL_SEEN))
)
- && !(RX_EXTFLAGS(rx) & RXf_NO_INPLACE_SUBST)
+ && !(RXp_EXTFLAGS(prog) & RXf_NO_INPLACE_SUBST)
&& (!doutf8 || SvUTF8(TARG))
&& !(rpm->op_pmflags & PMf_NONDESTRUCT))
{
if (once) {
char *d, *m;
- if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
+ if (RXp_MATCH_TAINTED(prog)) /* run time pattern taint, eg locale */
rxtainted |= SUBST_TAINT_PAT;
- m = orig + RX_OFFS(rx)[0].start;
- d = orig + RX_OFFS(rx)[0].end;
+ m = orig + RXp_OFFS(prog)[0].start;
+ d = orig + RXp_OFFS(prog)[0].end;
s = orig;
if (m - s > strend - d) { /* faster to shorten from end */
I32 i;
}
else {
char *d, *m;
- d = s = RX_OFFS(rx)[0].start + orig;
+ d = s = RXp_OFFS(prog)[0].start + orig;
do {
I32 i;
if (UNLIKELY(iters++ > maxiters))
DIE(aTHX_ "Substitution loop");
- if (UNLIKELY(RX_MATCH_TAINTED(rx))) /* run time pattern taint, eg locale */
+ /* run time pattern taint, eg locale */
+ if (UNLIKELY(RXp_MATCH_TAINTED(prog)))
rxtainted |= SUBST_TAINT_PAT;
- m = RX_OFFS(rx)[0].start + orig;
+ m = RXp_OFFS(prog)[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(rx)[0].end + orig;
+ s = RXp_OFFS(prog)[0].end + orig;
} while (CALLREGEXEC(rx, s, strend, orig,
s == m, /* don't match same null twice */
TARG, NULL,
#ifdef PERL_ANY_COW
have_a_cow:
#endif
- if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
+ if (RXp_MATCH_TAINTED(prog)) /* run time pattern taint, eg locale */
rxtainted |= SUBST_TAINT_PAT;
repl = dstr;
- s = RX_OFFS(rx)[0].start + orig;
+ s = RXp_OFFS(prog)[0].start + orig;
dstr = newSVpvn_flags(orig, s-orig,
SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
if (!c) {
do {
if (UNLIKELY(iters++ > maxiters))
DIE(aTHX_ "Substitution loop");
- if (UNLIKELY(RX_MATCH_TAINTED(rx)))
+ if (UNLIKELY(RXp_MATCH_TAINTED(prog)))
rxtainted |= SUBST_TAINT_PAT;
- if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
+ if (RXp_MATCH_COPIED(prog) && RXp_SUBBEG(prog) != orig) {
char *old_s = s;
char *old_orig = orig;
- assert(RX_SUBOFFSET(rx) == 0);
+ assert(RXp_SUBOFFSET(prog) == 0);
- orig = RX_SUBBEG(rx);
+ orig = RXp_SUBBEG(prog);
s = orig + (old_s - old_orig);
strend = s + (strend - old_s);
}
- m = RX_OFFS(rx)[0].start + orig;
+ m = RXp_OFFS(prog)[0].start + orig;
sv_catpvn_nomg_maybeutf8(dstr, s, m - s, DO_UTF8(TARG));
- s = RX_OFFS(rx)[0].end + orig;
+ s = RXp_OFFS(prog)[0].end + orig;
if (first) {
/* replacement already stringified */
if (clen)
((rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) ==
(SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
)
- (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */
+ (RXp_MATCH_TAINTED_on(prog)); /* taint $1 et al */
if (!(rxtainted & SUBST_TAINT_BOOLRET)
&& (rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT))
https://perl5.git.perl.org / perl5.git / blobdiff