diff options
author | David Mitchell <davem@iabyn.com> | 2015-03-13 12:39:42 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2015-03-13 12:39:42 +0000 |
commit | dc6240c9d6df97879ecb94e74011463d8dbdc837 (patch) | |
tree | 90d6fdc07f86e362a0495477397b9866cfe4f6f5 /dump.c | |
parent | dc3c1c7079dd7767e3d45a651b4fac4a932d25ed (diff) | |
download | perl-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.c | 32 |
1 files changed, 20 insertions, 12 deletions
@@ -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 |