[fwd] [PATCH] Add check for spurious PUSHMARKs by introducing POPBLOCK_normal. (from: gerard@ggoossen.net) #10013
Comments
From @obra-- |
From @obraAdd POPBLOCK_normal, which is similar to POPBLOCK, but instead of just This patch detects the spurious PUSHMARKs in Devel::PPPort::Perl_ppaddr_t and Gerard Goossen |
From @obra0003-Add-POPBLOCK_normal-which-is-similar-to-POPBLOCK-but.patchFrom 5858494a3c96d45bc6510dc9001d22feb0a6e571 Mon Sep 17 00:00:00 2001
From: Gerard Goossen <gerard@ggoossen.net>
Date: Wed, 18 Nov 2009 20:31:06 +0100
Subject: [PATCH 3/4] Add POPBLOCK_normal, which is similar to POPBLOCK, but instead of just
resetting the stack marker, it checks that the current stack marker is identical
to the saved stack marker, as should be the case when a block is normally
exited (without any flow control statement).
---
cop.h | 12 ++++++++++++
pp_ctl.c | 10 +++++-----
pp_hot.c | 4 ++--
3 files changed, 19 insertions(+), 7 deletions(-)
diff --git a/cop.h b/cop.h
index 0348324..5d5da29 100644
--- a/cop.h
+++ b/cop.h
@@ -562,6 +562,18 @@ struct block {
DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
(long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
+/* Exit a block at the end of its normal lifetime */
+#define POPBLOCK_normal(cx,pm) cx = &cxstack[cxstack_ix--], \
+ newsp = PL_stack_base + cx->blk_oldsp, \
+ PL_curcop = cx->blk_oldcop, \
+ assert(PL_markstack_ptr == PL_markstack + cx->blk_oldmarksp), \
+ PL_scopestack_ix = cx->blk_oldscopesp, \
+ pm = cx->blk_oldpm, \
+ gimme = cx->blk_gimme; \
+ DEBUG_SCOPE("POPBLOCK"); \
+ DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \
+ (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
+
/* Exit a block (RETURN and LAST). */
#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
newsp = PL_stack_base + cx->blk_oldsp, \
diff --git a/pp_ctl.c b/pp_ctl.c
index a629887..34b17bb 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2046,7 +2046,7 @@ PP(pp_leaveloop)
PMOP *newpm;
SV **mark;
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
assert(CxTYPE_is_LOOP(cx));
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
@@ -3770,7 +3770,7 @@ PP(pp_leaveeval)
const U8 save_flags = PL_op -> op_flags;
I32 optype;
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
POPEVAL(cx);
retop = cx->blk_eval.retop;
@@ -3889,7 +3889,7 @@ PP(pp_leavetry)
register PERL_CONTEXT *cx;
I32 optype;
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
POPEVAL(cx);
PERL_UNUSED_VAR(optype);
@@ -3954,7 +3954,7 @@ PP(pp_leavegiven)
PMOP *newpm;
PERL_UNUSED_CONTEXT;
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
assert(CxTYPE(cx) == CXt_GIVEN);
SP = newsp;
@@ -4524,7 +4524,7 @@ PP(pp_leavewhen)
SV **newsp;
PMOP *newpm;
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
assert(CxTYPE(cx) == CXt_WHEN);
SP = newsp;
diff --git a/pp_hot.c b/pp_hot.c
index 48b57d6..9c563e7 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1858,7 +1858,7 @@ PP(pp_leave)
cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
}
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
@@ -2498,7 +2498,7 @@ PP(pp_leavesublv)
if (CxMULTICALL(&cxstack[cxstack_ix]))
return 0;
- POPBLOCK(cx,newpm);
+ POPBLOCK_normal(cx,newpm);
cxstack_ix++; /* temporarily protect top context */
TAINT_NOT;
--
1.6.5
|
From @jkeenanThe patch attached to the original post makes changes in these files: cop.h | 12 ++++++++++++ Would anyone familiar with these source files care to evaluate the patch? Thank you very much. |
|
The RT System itself - Status changed from 'new' to 'open' |
From @cpansproutOn Wed Nov 30 19:23:00 2011, jkeenan wrote:
The patch looks good to me, but I am no expert on how the mark and -- Father Chrysostomos |
From @cpansproutOn Wed Nov 30 22:08:25 2011, sprout wrote:
Not so good, actually: $ ./perl harness -v ../cpan/Time-HiRes/t/stat.t Then the script hangs. -- Father Chrysostomos |
From @cpansproutOn Fri Dec 02 23:02:38 2011, sprout wrote:
I had to do some manual rebasing to get the patch to apply. It’s on the |
From [Unknown Contact. See original ticket]On Fri Dec 02 23:02:38 2011, sprout wrote:
I had to do some manual rebasing to get the patch to apply. It’s on the |
Migrated from rt.perl.org#71156 (status was 'open')
Searchable as RT71156$
The text was updated successfully, but these errors were encountered: