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)

diff --git a/dump.c b/dump.c
index 926e5f8..2e0bc01 100644 (file)
--- 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