STMT_START { \
SvGETMAGIC(rx); \
if (SvROK(rx) && SvAMAGIC(rx)) { \
- SV *sv = AMG_CALLun(rx, regexp); \
+ SV *sv = AMG_CALLunary(rx, regexp_amg); \
if (sv) { \
if (SvROK(sv)) \
sv = SvRV(sv); \
if (PL_op->op_flags & OPf_STACKED) {
- /* multiple args; concatentate them */
+ /* multiple args; concatenate them */
dMARK; dORIGMARK;
tmpstr = PAD_SV(ARGTARG);
sv_setpvs(tmpstr, "");
memNE(RX_PRECOMP(re), t, len))
{
const regexp_engine *eng = re ? RX_ENGINE(re) : NULL;
- U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
+ U32 pm_flags = pm->op_pmflags & RXf_PMf_COMPILETIME;
if (re) {
ReREFCNT_dec(re);
#ifdef USE_ITHREADS
#ifndef INCOMPLETE_TAINTS
if (PL_tainting) {
- if (PL_tainted)
+ if (PL_tainted) {
+ SvTAINTED_on((SV*)re);
RX_EXTFLAGS(re) |= RXf_TAINTED;
- else
- RX_EXTFLAGS(re) &= ~RXf_TAINTED;
+ }
}
#endif
SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
- if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
- cx->sb_rxtainted |= 2;
+ /* See "how taint works" above pp_subst() */
+ if (SvTAINTED(TOPs))
+ cx->sb_rxtainted |= SUBST_TAINT_REPL;
sv_catsv_nomg(dstr, POPs);
/* XXX: adjust for positive offsets of \G for instance s/(.)\G//g with positive pos() */
s -= RX_GOFS(rx);
else
sv_catpvn(dstr, s, cx->sb_strend - s);
}
- cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
+ if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
+ cx->sb_rxtainted |= SUBST_TAINT_PAT;
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(targ)) {
SvUTF8_on(targ);
SvPV_set(dstr, NULL);
- TAINT_IF(cx->sb_rxtainted & 1);
if (pm->op_pmflags & PMf_NONDESTRUCT)
PUSHs(targ);
else
mPUSHi(saviters - 1);
(void)SvPOK_only_UTF8(targ);
- TAINT_IF(cx->sb_rxtainted);
- SvSETMAGIC(targ);
- SvTAINT(targ);
+ /* update the taint state of various various variables in
+ * preparation for final exit.
+ * See "how taint works" above pp_subst() */
+ if (PL_tainting) {
+ if ((cx->sb_rxtainted & SUBST_TAINT_PAT) ||
+ ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
+ == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
+ )
+ (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */
+
+ if (!(cx->sb_rxtainted & SUBST_TAINT_BOOLRET)
+ && (cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT))
+ )
+ SvTAINTED_on(TOPs); /* taint return value */
+ /* needed for mg_set below */
+ PL_tainted = cBOOL(cx->sb_rxtainted &
+ (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL));
+ SvTAINT(TARG);
+ }
+ /* PL_tainted must be correctly set for this mg_set */
+ SvSETMAGIC(TARG);
+ TAINT_NOT;
LEAVE_SCOPE(cx->sb_oldsave);
POPSUBST(cx);
RETURNOP(pm->op_next);
+ /* NOTREACHED */
}
cx->sb_iters = saviters;
}
}
if (old != rx)
(void)ReREFCNT_inc(rx);
- cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
+ /* update the taint state of various various variables in preparation
+ * for calling the code block.
+ * See "how taint works" above pp_subst() */
+ if (PL_tainting) {
+ if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
+ cx->sb_rxtainted |= SUBST_TAINT_PAT;
+
+ if ((cx->sb_rxtainted & SUBST_TAINT_PAT) ||
+ ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
+ == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
+ )
+ (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */
+
+ if (cx->sb_iters > 1 && (cx->sb_rxtainted &
+ (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL)))
+ SvTAINTED_on(cx->sb_targ);
+ TAINT_NOT;
+ }
rxres_save(&cx->sb_rxres, rx);
PL_curpm = pm;
RETURNOP(pm->op_pmstashstartu.op_pmreplstart);
RETURNOP(PL_op->op_next->op_next);
}
PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
- pp_pushmark(); /* push dst */
- pp_pushmark(); /* push src */
+ Perl_pp_pushmark(aTHX); /* push dst */
+ Perl_pp_pushmark(aTHX); /* push src */
ENTER_with_name("grep"); /* enter outer scope */
SAVETMPS;
PUTBACK;
if (PL_op->op_type == OP_MAPSTART)
- pp_pushmark(); /* push top */
+ Perl_pp_pushmark(aTHX); /* push top */
return ((LOGOP*)PL_op->op_next)->op_other;
}
/* we get here either during compilation, or via pp_regcomp at runtime */
runtime = IN_PERL_RUNTIME;
if (runtime)
+ {
runcv = find_runcv(NULL);
+ /* At run time, we have to fetch the hints from PL_curcop. */
+ PL_hints = PL_curcop->cop_hints;
+ if (PL_hints & HINT_LOCALIZE_HH) {
+ /* SAVEHINTS created a new HV in PL_hintgv, which we
+ need to GC */
+ SvREFCNT_dec(GvHV(PL_hintgv));
+ GvHV(PL_hintgv) =
+ refcounted_he_chain_2hv(PL_curcop->cop_hints_hash, 0);
+ hv_magic(GvHV(PL_hintgv), NULL, PERL_MAGIC_hints);
+ }
+ SAVECOMPILEWARNINGS();
+ PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
+ cophh_free(CopHINTHASH_get(&PL_compiling));
+ /* XXX Does this need to avoid copying a label? */
+ PL_compiling.cop_hints_hash
+ = cophh_copy(PL_curcop->cop_hints_hash);
+ }
+
PL_op = &dummy;
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
}
}
}
- if (tryrsfp) {
- SAVECOPFILE_FREE(&PL_compiling);
- CopFILE_set(&PL_compiling, tryname);
- }
- SvREFCNT_dec(namesv);
+ sv_2mortal(namesv);
if (!tryrsfp) {
if (PL_op->op_type == OP_REQUIRE) {
if(errno == EMFILE) {
/* Check whether a hook in @INC has already filled %INC */
if (!hook_sv) {
(void)hv_store(GvHVn(PL_incgv),
- unixname, unixlen, newSVpv(CopFILE(&PL_compiling),0),0);
+ unixname, unixlen, newSVpv(tryname,0),0);
} else {
SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
if (!svp)
ENTER_with_name("eval");
SAVETMPS;
+ SAVECOPFILE_FREE(&PL_compiling);
+ CopFILE_set(&PL_compiling, tryname);
lex_start(NULL, tryrsfp, 0);
SAVEHINTS();
}
return DOCATCH(PL_eval_start);
} else {
- /* We have already left the scope set up earler thanks to the LEAVE
+ /* We have already left the scope set up earlier thanks to the LEAVE
in doeval(). */
if (was != PL_breakable_sub_gen /* Some subs defined here. */
? (PERLDB_LINE || PERLDB_SAVESRC)
PL_op = (OP *) matcher;
XPUSHs(sv);
PUTBACK;
- (void) pp_match();
+ (void) Perl_pp_match(aTHX);
SPAGAIN;
return (SvTRUEx(POPs));
}
PUSHs(d); PUSHs(e);
PUTBACK;
if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
- (void) pp_i_eq();
+ (void) Perl_pp_i_eq(aTHX);
else
- (void) pp_eq();
+ (void) Perl_pp_eq(aTHX);
SPAGAIN;
if (SvTRUEx(POPs))
RETPUSHYES;
DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Any\n"));
PUSHs(d); PUSHs(e);
PUTBACK;
- return pp_seq();
+ return Perl_pp_seq(aTHX);
}
PP(pp_enterwhen)
if (take) {
sv_catpvn(buf_sv, cache_p, take);
sv_chop(cache, cache_p + take);
- /* Definately not EOF */
+ /* Definitely not EOF */
return 1;
}
https://perl5.git.perl.org / perl5.git / blobdiff