Help -Dt show correct pad variables

[p5sagit/p5-mst-13.2.git] / run.c

diff --git a/run.c b/run.c
index 1b1e72b..054abfe 100644 (file)
--- a/run.c
+++ b/run.c
@@ -63,8 +63,9 @@ I32
 Perl_debop(pTHX_ OP *o)
 {
 #ifdef DEBUGGING
+    AV *padlist, *comppad;
+    CV *cv;
     SV *sv;
-    SV **svp;
     STRLEN n_a;
     Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
     switch (o->op_type) {
@@ -86,12 +87,18 @@ Perl_debop(pTHX_ OP *o)
     case OP_PADAV:
     case OP_PADHV:
        /* print the lexical's name */
-       svp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
-       if (svp)
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV(*svp,n_a));
-       else
+        cv = deb_curcv(cxstack_ix);
+        if (cv) {
+            padlist = CvPADLIST(cv);
+            comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
+            sv = *av_fetch(comppad, o->op_targ, FALSE);
+        } else
+            sv = Nullsv;
+        if (sv)
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
+        else
            PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
-       break;
+        break;
     default:
        break;
     }
@@ -100,6 +107,27 @@ Perl_debop(pTHX_ OP *o)
     return 0;
 }
 
+STATIC CV*
+S_deb_curcv(I32 ix)
+{
+#ifdef DEBUGGING
+    PERL_CONTEXT *cx = &cxstack[ix];
+    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
+        return cx->blk_sub.cv;
+    else if (CxTYPE(cx) == CXt_EVAL && PL_compcv)
+        /* XXX Should be PL_compcv? */
+        return Nullcv;
+    else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
+        return PL_main_cv;
+    else if (ix <= 0)
+        return Nullcv;
+    else
+        return deb_curcv(ix - 1);
+#else
+    return Nullcv;
+#endif  /* DEBUGGING */
+}
+
 void
 Perl_watch(pTHX_ char **addr)
 {