summaryrefslogtreecommitdiff
path: root/dump.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2015-03-13 12:39:42 +0000
committerDavid Mitchell <davem@iabyn.com>2015-03-13 12:39:42 +0000
commitdc6240c9d6df97879ecb94e74011463d8dbdc837 (patch)
tree90d6fdc07f86e362a0495477397b9866cfe4f6f5 /dump.c
parentdc3c1c7079dd7767e3d45a651b4fac4a932d25ed (diff)
downloadperl-dc6240c9d6df97879ecb94e74011463d8dbdc837.tar.gz
make perl -Dt display padnames with sort blocks
When a sort block (as opposed to sort sub) is executed, a new stackinfo is pushed with a single CXt_NULL on top. Since S_deb_curcv() only examines the *current* CX stack looking for the current running CV, it fails to find it in this case and returns null. This means that on threaded builds you get things like: $ perl -Dt -e'my $x; @a=sort { $x } 1,2' ... (-e:1) padsv([1]) where it can't find a pad to look up the name of the lexical at targ 1. This commit makes S_deb_curcv() continue to the previous CX stack when it finds it's on a PERLSI_SORT stackinfo. The output from the above is now: (-e:1) padsv($x)
Diffstat (limited to 'dump.c')
-rw-r--r--dump.c32
1 files changed, 20 insertions, 12 deletions
diff --git a/dump.c b/dump.c
index 926e5f8bcb..2e0bc019cf 100644
--- a/dump.c
+++ b/dump.c
@@ -2537,19 +2537,27 @@ Perl_debop(pTHX_ const OP *o)
}
STATIC CV*
-S_deb_curcv(pTHX_ const I32 ix)
+S_deb_curcv(pTHX_ I32 ix)
{
- const PERL_CONTEXT * const cx = &cxstack[ix];
- if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
- return cx->blk_sub.cv;
- else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
- return cx->blk_eval.cv;
- else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
- return PL_main_cv;
- else if (ix <= 0)
- return NULL;
- else
- return deb_curcv(ix - 1);
+ PERL_SI *si = PL_curstackinfo;
+ for (; ix >=0; ix--) {
+ const PERL_CONTEXT * const cx = &(si->si_cxstack)[ix];
+
+ if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
+ return cx->blk_sub.cv;
+ else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
+ return cx->blk_eval.cv;
+ else if (ix == 0 && si->si_type == PERLSI_MAIN)
+ return PL_main_cv;
+ else if (ix == 0 && CxTYPE(cx) == CXt_NULL
+ && si->si_type == PERLSI_SORT)
+ {
+ /* fake sort sub; use CV of caller */
+ si = si->si_prev;
+ ix = si->si_cxix + 1;
+ }
+ }
+ return NULL;
}
void