This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
start cleaning up perldelta for 5.17.6
[perl5.git]
/
pp_ctl.c
diff --git
a/pp_ctl.c
b/pp_ctl.c
index
22e1cea
..
24eac16
100644
(file)
--- a/
pp_ctl.c
+++ b/
pp_ctl.c
@@
-2000,8
+2000,12
@@
PP(pp_dbstate)
PUSHSUB_DB(cx);
cx->blk_sub.retop = PL_op->op_next;
CvDEPTH(cv)++;
PUSHSUB_DB(cx);
cx->blk_sub.retop = PL_op->op_next;
CvDEPTH(cv)++;
+ if (CvDEPTH(cv) >= 2) {
+ PERL_STACK_OVERFLOW_CHECK();
+ pad_push(CvPADLIST(cv), CvDEPTH(cv));
+ }
SAVECOMPPAD();
SAVECOMPPAD();
- PAD_SET_CUR_NOSAVE(CvPADLIST(cv),
1
);
+ PAD_SET_CUR_NOSAVE(CvPADLIST(cv),
CvDEPTH(cv)
);
RETURNOP(CvSTART(cv));
}
}
RETURNOP(CvSTART(cv));
}
}
@@
-2799,13
+2803,17
@@
PP(pp_goto)
FREETMPS;
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
FREETMPS;
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
+ {
+ SvREFCNT_dec(cv);
DIE(aTHX_ "Can't goto subroutine outside a subroutine");
DIE(aTHX_ "Can't goto subroutine outside a subroutine");
+ }
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
SPAGAIN;
/* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
if (CxTYPE(cx) == CXt_EVAL) {
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
SPAGAIN;
/* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
if (CxTYPE(cx) == CXt_EVAL) {
+ SvREFCNT_dec(cv);
if (CxREALEVAL(cx))
/* diag_listed_as: Can't goto subroutine from an eval-%s */
DIE(aTHX_ "Can't goto subroutine from an eval-string");
if (CxREALEVAL(cx))
/* diag_listed_as: Can't goto subroutine from an eval-%s */
DIE(aTHX_ "Can't goto subroutine from an eval-string");
@@
-2814,7
+2822,10
@@
PP(pp_goto)
DIE(aTHX_ "Can't goto subroutine from an eval-block");
}
else if (CxMULTICALL(cx))
DIE(aTHX_ "Can't goto subroutine from an eval-block");
}
else if (CxMULTICALL(cx))
+ {
+ SvREFCNT_dec(cv);
DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
+ }
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
AV* av = cx->blk_sub.argarray;
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
AV* av = cx->blk_sub.argarray;
@@
-2889,11
+2900,6
@@
PP(pp_goto)
}
else {
PADLIST * const padlist = CvPADLIST(cv);
}
else {
PADLIST * const padlist = CvPADLIST(cv);
- if (CxTYPE(cx) == CXt_EVAL) {
- PL_in_eval = CxOLD_IN_EVAL(cx);
- PL_eval_root = cx->blk_eval.old_eval_root;
- cx->cx_type = CXt_SUB;
- }
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
@@
-3261,7
+3267,7
@@
Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
switch (cond) {
case FIND_RUNCV_padid_eq:
if (!CvPADLIST(cv)
switch (cond) {
case FIND_RUNCV_padid_eq:
if (!CvPADLIST(cv)
- || PadlistNAMES(CvPADLIST(cv)) !=
(PADNAMELIST *)arg
)
+ || PadlistNAMES(CvPADLIST(cv)) !=
INT2PTR(PADNAMELIST *, arg)
)
continue;
return cv;
case FIND_RUNCV_level_eq:
continue;
return cv;
case FIND_RUNCV_level_eq: