Re: [PATCH] s/Null(av|ch)/NULL/g

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

diff --git a/dump.c b/dump.c
index 0679ed9..088e860 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1,7 +1,7 @@
 /*    dump.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -41,6 +41,7 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 void
 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 {
+    dVAR;
     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
     PerlIO_vprintf(file, pat, *args);
 }
@@ -48,6 +49,7 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 void
 Perl_dump_all(pTHX)
 {
+    dVAR;
     PerlIO_setlinebuf(Perl_debug_log);
     if (PL_main_root)
        op_dump(PL_main_root);
@@ -57,6 +59,7 @@ Perl_dump_all(pTHX)
 void
 Perl_dump_packsubs(pTHX_ const HV *stash)
 {
+    dVAR;
     I32        i;
 
     if (!HvARRAY(stash))
@@ -84,7 +87,7 @@ Perl_dump_sub(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
     if (CvXSUB(GvCV(gv)))
        Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
@@ -101,7 +104,7 @@ Perl_dump_form(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
     if (CvROOT(GvFORM(gv)))
        op_dump(CvROOT(GvFORM(gv)));
@@ -112,6 +115,7 @@ Perl_dump_form(pTHX_ const GV *gv)
 void
 Perl_dump_eval(pTHX)
 {
+    dVAR;
     op_dump(PL_eval_root);
 }
 
@@ -128,12 +132,12 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
            break;
         }
        switch (*pv) {
-       case '\t': sv_catpvn(dsv, "\\t", 2);  break;
-       case '\n': sv_catpvn(dsv, "\\n", 2);  break;
-       case '\r': sv_catpvn(dsv, "\\r", 2);  break;
-       case '\f': sv_catpvn(dsv, "\\f", 2);  break;
-       case '"':  sv_catpvn(dsv, "\\\"", 2); break;
-       case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+       case '\t': sv_catpvs(dsv, "\\t");  break;
+       case '\n': sv_catpvs(dsv, "\\n");  break;
+       case '\r': sv_catpvs(dsv, "\\r");  break;
+       case '\f': sv_catpvs(dsv, "\\f");  break;
+       case '"':  sv_catpvs(dsv, "\\\""); break;
+       case '\\': sv_catpvs(dsv, "\\\\"); break;
        default:
            if (isPRINT(*pv))
                sv_catpvn(dsv, pv, 1);
@@ -143,11 +147,11 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
                Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
         }
     }
-    sv_catpvn(dsv, "\"", 1);
+    sv_catpvs(dsv, "\"");
     if (truncated)
-       sv_catpvn(dsv, "...", 3);
+       sv_catpvs(dsv, "...");
     if (nul_terminated)
-       sv_catpvn(dsv, "\\0", 2);
+       sv_catpvs(dsv, "\\0");
 
     return SvPVX(dsv);
 }
@@ -301,7 +305,7 @@ Perl_sv_peek(pTHX_ SV *sv)
        if (!SvPVX_const(sv))
            sv_catpv(t, "(null)");
        else {
-           SV *tmp = newSVpvn("", 0);
+           SV *tmp = newSVpvs("");
            sv_catpv(t, "(");
            if (SvOOK(sv))
                Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
@@ -361,7 +365,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
        op_dump(pm->op_pmreplroot);
     }
     if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
-       SV *tmpsv = newSVpvn("", 0);
+       SV *tmpsv = newSVpvs("");
        if (pm->op_pmdynflags & PMdf_USED)
            sv_catpv(tmpsv, ",USED");
        if (pm->op_pmdynflags & PMdf_TAINTED)
@@ -555,7 +559,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
 #endif
     if (o->op_flags) {
-       SV *tmpsv = newSVpvn("", 0);
+       SV *tmpsv = newSVpvs("");
        switch (o->op_flags & OPf_WANT) {
        case OPf_WANT_VOID:
            sv_catpv(tmpsv, ",VOID");
@@ -586,7 +590,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
        SvREFCNT_dec(tmpsv);
     }
     if (o->op_private) {
-       SV *tmpsv = newSVpvn("", 0);
+       SV *tmpsv = newSVpvs("");
        if (PL_opargs[o->op_type] & OA_TARGLEX) {
            if (o->op_private & OPpTARGET_MY)
                sv_catpv(tmpsv, ",TARGET_MY");
@@ -765,10 +769,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #else
        if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
            if (cSVOPo->op_sv) {
-               SV *tmpsv = NEWSV(0,0);
+               SV *tmpsv = newSV(0);
                ENTER;
                SAVEFREESV(tmpsv);
-               gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
+               gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, NULL);
                Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
                                 SvPV_nolen_const(tmpsv));
                LEAVE;
@@ -871,10 +875,10 @@ Perl_gv_dump(pTHX_ GV *gv)
     }
     sv = sv_newmortal();
     PerlIO_printf(Perl_debug_log, "{\n");
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
     if (gv != GvEGV(gv)) {
-       gv_efullname3(sv, GvEGV(gv), Nullch);
+       gv_efullname3(sv, GvEGV(gv), NULL);
        Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
     }
     PerlIO_putc(Perl_debug_log, '\n');
@@ -1023,7 +1027,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
            Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
            if (mg->mg_len >= 0) {
                if (mg->mg_type != PERL_MAGIC_utf8) {
-                   SV *sv = newSVpvn("", 0);
+                   SV *sv = newSVpvs("");
                    PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
                    SvREFCNT_dec(sv);
                }
@@ -1097,6 +1101,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
+    dVAR;
     SV *d;
     const char *s;
     U32 flags;
@@ -1439,9 +1444,18 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            if (hvname)
                Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", hvname);
        }
+       if (SvOOK(sv)) {
+           AV *backrefs = *Perl_hv_backreferences_p(aTHX_ (HV*)sv);
+           if (backrefs) {
+               Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
+                                PTR2UV(backrefs));
+               do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest,
+                          dumpops, pvlim);
+           }
+       }
        if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
            HE *he;
-           HV *hv = (HV*)sv;
+           HV * const hv = (HV*)sv;
            int count = maxnest - nest;
 
            hv_iterinit(hv);
@@ -1450,7 +1464,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                SV *elt, *keysv;
                 const char *keypv;
                STRLEN len;
-               U32 hash = HeHASH(he);
+               const U32 hash = HeHASH(he);
 
                keysv = hv_iterkeysv(he);
                keypv = SvPV_const(keysv, len);
@@ -1577,12 +1591,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 void
 Perl_sv_dump(pTHX_ SV *sv)
 {
+    dVAR;
     do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
 }
 
 int
 Perl_runops_debug(pTHX)
 {
+    dVAR;
     if (!PL_op) {
        if (ckWARN_d(WARN_DEBUGGING))
            Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
@@ -1621,6 +1637,7 @@ Perl_runops_debug(pTHX)
 I32
 Perl_debop(pTHX_ const OP *o)
 {
+    dVAR;
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return 0;
 
@@ -1632,8 +1649,8 @@ Perl_debop(pTHX_ const OP *o)
     case OP_GVSV:
     case OP_GV:
        if (cGVOPo_gv) {
-           SV *sv = NEWSV(0,0);
-           gv_fullname3(sv, cGVOPo_gv, Nullch);
+           SV *sv = newSV(0);
+           gv_fullname3(sv, cGVOPo_gv, NULL);
            PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
            SvREFCNT_dec(sv);
        }
@@ -1669,6 +1686,7 @@ Perl_debop(pTHX_ const OP *o)
 STATIC CV*
 S_deb_curcv(pTHX_ I32 ix)
 {
+    dVAR;
     const PERL_CONTEXT *cx = &cxstack[ix];
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
         return cx->blk_sub.cv;
@@ -1685,6 +1703,7 @@ S_deb_curcv(pTHX_ I32 ix)
 void
 Perl_watch(pTHX_ char **addr)
 {
+    dVAR;
     PL_watchaddr = addr;
     PL_watchok = *addr;
     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
@@ -1694,6 +1713,7 @@ Perl_watch(pTHX_ char **addr)
 STATIC void
 S_debprof(pTHX_ const OP *o)
 {
+    dVAR;
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return;
     if (!PL_profiledata)
@@ -1704,6 +1724,7 @@ S_debprof(pTHX_ const OP *o)
 void
 Perl_debprofdump(pTHX)
 {
+    dVAR;
     unsigned i;
     if (!PL_profiledata)
        return;