}
-#ifndef INCOMPLETE_TAINTS
if (TAINTING_get && TAINT_get) {
SvTAINTED_on((SV*)new_re);
RX_TAINT_on(new_re);
}
-#endif
#if !defined(USE_ITHREADS)
/* can't change the optree at runtime either */
return NORMAL;
}
+/* SVs on the stack that have any of the flags passed in are left as is.
+ Other SVs are protected via the mortals stack if lvalue is true, and
+ copied otherwise. */
+
STATIC SV **
-S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags)
+S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
+ U32 flags, bool lvalue)
{
bool padtmp = 0;
PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE;
if (gimme == G_SCALAR) {
if (MARK < SP)
*++newsp = ((SvFLAGS(*SP) & flags) || (padtmp && SvPADTMP(*SP)))
- ? *SP : sv_mortalcopy(*SP);
+ ? *SP
+ : lvalue
+ ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
+ : sv_mortalcopy(*SP);
else {
/* MEXTEND() only updates MARK, so reuse it instead of newsp. */
MARK = newsp;
if ((SvFLAGS(*MARK) & flags) || (padtmp && SvPADTMP(*MARK)))
*++newsp = *MARK;
else {
- *++newsp = sv_mortalcopy(*MARK);
+ *++newsp = lvalue
+ ? sv_2mortal(SvREFCNT_inc_simple_NN(*MARK))
+ : sv_mortalcopy(*MARK);
TAINT_NOT; /* Each item is independent */
}
}
gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
TAINT_NOT;
- SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+ SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
+ PL_op->op_private & OPpLVALUE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE_with_name("block");
newsp = PL_stack_base + cx->blk_loop.resetsp;
TAINT_NOT;
- SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0);
+ SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0,
+ PL_op->op_private & OPpLVALUE);
PUTBACK;
POPLOOP(cx); /* Stack values are safe: release loop vars ... */
OP *nextop = NULL;
SV **newsp;
PMOP *newpm;
- SV **mark;
SV *sv = NULL;
S_unwind_loop(aTHX_ "last");
POPBLOCK(cx,newpm);
cxstack_ix++; /* temporarily protect top context */
- mark = newsp;
switch (CxTYPE(cx)) {
case CXt_LOOP_LAZYIV:
case CXt_LOOP_LAZYSV:
}
TAINT_NOT;
- PL_stack_sp = adjust_stack_on_leave(newsp, PL_stack_sp, MARK, gimme,
- pop2 == CXt_SUB ? SVs_TEMP : 0);
+ PL_stack_sp = newsp;
LEAVE;
cxstack_ix--;
return 0;
}
-PP(pp_goto)
+PP(pp_goto) /* also pp_dump */
{
dVAR; dSP;
OP *retop = NULL;
static const char* const must_have_label = "goto must have label";
if (PL_op->op_flags & OPf_STACKED) {
+ /* goto EXPR or goto &foo */
+
SV * const sv = POPs;
SvGETMAGIC(sv);
OP* const retop = cx->blk_sub.retop;
SV **newsp;
I32 gimme;
- const SSize_t items = AvFILLp(arg) + 1;
+ const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
+ const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0;
SV** mark;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
/* put GvAV(defgv) back onto stack */
- EXTEND(SP, items+1); /* @_ could have been extended. */
- Copy(AvARRAY(arg), SP + 1, items, SV*);
+ if (items) {
+ EXTEND(SP, items+1); /* @_ could have been extended. */
+ }
mark = SP;
- SP += items;
- if (AvREAL(arg)) {
- I32 index;
+ if (items) {
+ SSize_t index;
+ bool r = cBOOL(AvREAL(arg));
for (index=0; index<items; index++)
- if (SP[-index])
- SvREFCNT_inc_void_NN(sv_2mortal(SP[-index]));
- else {
- SP[-index] = sv_2mortal(newSVavdefelem(arg,
- AvFILLp(arg) - index, 1));
+ {
+ SV *sv;
+ if (m) {
+ SV ** const svp = av_fetch(arg, index, 0);
+ sv = svp ? *svp : NULL;
}
+ else sv = AvARRAY(arg)[index];
+ SP[index+1] = sv
+ ? r ? SvREFCNT_inc_NN(sv_2mortal(sv)) : sv
+ : sv_2mortal(newSVavdefelem(arg, index, 1));
+ }
}
+ SP += items;
SvREFCNT_dec(arg);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
/* Restore old @_ */
}
}
else {
+ /* goto EXPR */
label = SvPV_nomg_const(sv, label_len);
label_flags = SvUTF8(sv);
}
}
else if (!(PL_op->op_flags & OPf_SPECIAL)) {
+ /* goto LABEL or dump LABEL */
label = cPVOP->op_pv;
label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
label_len = strlen(label);
S_check_type_and_open(pTHX_ SV *name)
{
Stat_t st;
- const char *p = SvPV_nolen_const(name);
+ STRLEN len;
+ const char *p = SvPV_const(name, len);
int st_rc;
PERL_ARGS_ASSERT_CHECK_TYPE_AND_OPEN;
* rather than for the .pm file.
* This check prevents a \0 in @INC causing problems.
*/
- if (!IS_SAFE_PATHNAME(name, "require"))
+ if (!IS_SAFE_PATHNAME(p, len, "require"))
return NULL;
+ /* we use the value of errno later to see how stat() or open() failed.
+ * We don't want it set if the stat succeeded but we still failed,
+ * such as if the name exists, but is a directory */
+ errno = 0;
+
st_rc = PerlLIO_stat(p, &st);
if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
* warning referring to the .pmc which the user probably doesn't
* know or care about
*/
- if (!IS_SAFE_PATHNAME(name, "require"))
+ if (!IS_SAFE_PATHNAME(p, namelen, "require"))
return NULL;
if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
name = SvPV_const(sv, len);
if (!(name && len > 0 && *name))
DIE(aTHX_ "Null filename used");
- if (!IS_SAFE_PATHNAME(sv, "require")) {
+ if (!IS_SAFE_PATHNAME(name, len, "require")) {
DIE(aTHX_ "Can't locate %s: %s",
pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
SvCUR(sv)*2,NULL, SvUTF8(sv)?PERL_PV_ESCAPE_UNI:0),
SP--;
}
+ /* FREETMPS may free our filter_cache */
+ SvREFCNT_inc_simple_void(filter_cache);
+
PUTBACK;
FREETMPS;
LEAVE_with_name("call_INC");
+ /* Now re-mortalize it. */
+ sv_2mortal(filter_cache);
+
/* Adjust file name if the hook has set an %INC entry.
This needs to happen after the FREETMPS above. */
svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
dirlen = 0;
}
+ if (!IS_SAFE_SYSCALL(dir, dirlen, "@INC entry", "require"))
+ continue;
#ifdef VMS
if (((unixdirbuf = SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1)))) == NULL)
|| ((unixdir = tounixpath(dir, unixdirbuf)) == NULL))
TAINT_NOT;
SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
- gimme, SVs_TEMP);
+ gimme, SVs_TEMP, FALSE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
#ifdef DEBUGGING
PERL_UNUSED_VAR(optype);
TAINT_NOT;
- SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+ SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+ SVs_PADTMP|SVs_TEMP, FALSE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE_with_name("eval_scope");
assert(CxTYPE(cx) == CXt_GIVEN);
TAINT_NOT;
- SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+ SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+ SVs_PADTMP|SVs_TEMP, FALSE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE_with_name("given");
assert(CxTYPE(cx) == CXt_WHEN);
TAINT_NOT;
- SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+ SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+ SVs_PADTMP|SVs_TEMP, FALSE);
PL_curpm = newpm; /* pop $1 et al */
LEAVE_with_name("when");
https://perl5.git.perl.org / perl5.git / blobdiff