X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=run.c;h=054abfedae72fcc55c70ffb7236839e9bd11f970;hb=53a2efa2dc68a3abcc2483f05bd06213caea8bbd;hp=1b1e72b1a6c0e1775178cfd9b43a3b732f7be08f;hpb=ffb9ee5f5f9d80d28ce950a2ff357650c8f1cc03;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/run.c b/run.c
index 1b1e72b..054abfe 100644
--- 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)
 {