add support for assertions. Updated form of:

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

diff --git a/dump.c b/dump.c
index 45d7494..d545368 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -73,7 +73,7 @@ Perl_dump_sub(pTHX_ GV *gv)
     SV *sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %"SVf" = ", sv);
     if (CvXSUB(GvCV(gv)))
        Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
            PTR2UV(CvXSUB(GvCV(gv))),
@@ -90,7 +90,7 @@ Perl_dump_form(pTHX_ GV *gv)
     SV *sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %"SVf" = ", sv);
     if (CvROOT(GvFORM(gv)))
        op_dump(CvROOT(GvFORM(gv)));
     else
@@ -194,11 +194,23 @@ Perl_sv_peek(pTHX_ SV *sv)
        sv_catpv(t, "(");
        unref++;
     }
-    else if (DEBUG_R_TEST_ && SvREFCNT(sv) > 1) {
-       Perl_sv_catpvf(aTHX_ t, "<%"UVuf">", (UV)SvREFCNT(sv));
+    else if (DEBUG_R_TEST_) {
+       int is_tmp = 0;
+       I32 ix;
+       /* is this SV on the tmps stack? */
+       for (ix=PL_tmps_ix; ix>=0; ix--) {
+           if (PL_tmps_stack[ix] == sv) {
+               is_tmp = 1;
+               break;
+           }
+       }
+       if (SvREFCNT(sv) > 1)
+           Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
+                   is_tmp ? "T" : "");
+       else if (is_tmp)
+           sv_catpv(t, "<T>");
     }
 
-
     if (SvROK(sv)) {
        sv_catpv(t, "\\");
        if (SvCUR(t) + unref > 10) {
@@ -619,11 +631,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 #else
        if (cSVOPo->op_sv) {
            SV *tmpsv = NEWSV(0,0);
-           STRLEN n_a;
            ENTER;
            SAVEFREESV(tmpsv);
            gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
-           Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
+           Perl_dump_indent(aTHX_ level, file, "GV = %"SVf"\n", tmpsv);
            LEAVE;
        }
        else
@@ -632,7 +643,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        break;
     case OP_CONST:
     case OP_METHOD_NAMED:
-       Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv));
+       Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
        break;
     case OP_SETSTATE:
     case OP_NEXTSTATE:
@@ -719,10 +730,10 @@ Perl_gv_dump(pTHX_ GV *gv)
     sv = sv_newmortal();
     PerlIO_printf(Perl_debug_log, "{\n");
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %"SVf"", sv);
     if (gv != GvEGV(gv)) {
        gv_efullname3(sv, GvEGV(gv), Nullch);
-       Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv));
+       Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %"SVf"", sv);
     }
     PerlIO_putc(Perl_debug_log, '\n');
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
@@ -769,6 +780,7 @@ static struct { char type; char *name; } magic_names[] = {
        { PERL_MAGIC_uvar_elem,      "uvar_elem(v)" },
        { PERL_MAGIC_vec,            "vec(v)" },
        { PERL_MAGIC_vstring,        "vstring(V)" },
+       { PERL_MAGIC_utf8,           "utf8(w)" },
        { PERL_MAGIC_substr,         "substr(x)" },
        { PERL_MAGIC_defelem,        "defelem(y)" },
        { PERL_MAGIC_ext,            "ext(~)" },
@@ -812,6 +824,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
            else if (v == &PL_vtbl_amagic)     s = "amagic";
            else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
            else if (v == &PL_vtbl_backref)    s = "backref";
+           else if (v == &PL_vtbl_utf8)       s = "utf8";
            if (s)
                Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
            else
@@ -863,9 +876,11 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
         if (mg->mg_ptr) {
            Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
            if (mg->mg_len >= 0) {
-               SV *sv = newSVpvn("", 0);
-                PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
-               SvREFCNT_dec(sv);
+               if (mg->mg_type != PERL_MAGIC_utf8) {
+                   SV *sv = newSVpvn("", 0);
+                   PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
+                   SvREFCNT_dec(sv);
+               }
             }
            else if (mg->mg_len == HEf_SVKEY) {
                PerlIO_puts(file, " => HEf_SVKEY\n");
@@ -876,6 +891,18 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
                PerlIO_puts(file, " ???? - please notify IZ");
             PerlIO_putc(file, '\n');
         }
+       if (mg->mg_type == PERL_MAGIC_utf8) {
+           STRLEN *cache = (STRLEN *) mg->mg_ptr;
+           if (cache) {
+               IV i;
+               for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
+                   Perl_dump_indent(aTHX_ level, file,
+                                    "      %2"IVdf": %"UVuf" -> %"UVuf"\n",
+                                    i,
+                                    (UV)cache[i * 2],
+                                    (UV)cache[i * 2 + 1]);
+           }
+       }
     }
 }
 
@@ -926,7 +953,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     char *s;
     U32 flags;
     U32 type;
-    STRLEN n_a;
 
     if (!sv) {
        Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
@@ -942,7 +968,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                   (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
                   (int)(PL_dumpindent*level), "");
 
-    if (flags & SVs_PADBUSY)   sv_catpv(d, "PADBUSY,");
+    if (flags & SVs_PADSTALE)  sv_catpv(d, "PADSTALE,");
     if (flags & SVs_PADTMP)    sv_catpv(d, "PADTMP,");
     if (flags & SVs_PADMY)     sv_catpv(d, "PADMY,");
     if (flags & SVs_TEMP)      sv_catpv(d, "TEMP,");
@@ -981,6 +1007,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (CvLVALUE(sv))       sv_catpv(d, "LVALUE,");
        if (CvMETHOD(sv))       sv_catpv(d, "METHOD,");
        if (CvLOCKED(sv))       sv_catpv(d, "LOCKED,");
+       if (CvWEAKOUTSIDE(sv))  sv_catpv(d, "WEAKOUTSIDE,");
+       if (CvASSERTION(sv))    sv_catpv(d, "ASSERTION,");
        break;
     case SVt_PVHV:
        if (HvSHAREKEYS(sv))    sv_catpv(d, "SHAREKEYS,");
@@ -1272,7 +1300,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        break;
     case SVt_PVCV:
        if (SvPOK(sv))
-           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
+           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV_nolen(sv));
        /* FALL THROUGH */
     case SVt_PVFM:
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
@@ -1287,6 +1315,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
        Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
+       Perl_dump_indent(aTHX_ level, file, "  OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
        if (type == SVt_PVFM)
            Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)FmLINES(sv));
        Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
@@ -1403,7 +1432,6 @@ Perl_debop(pTHX_ OP *o)
     AV *padlist, *comppad;
     CV *cv;
     SV *sv;
-    STRLEN n_a;
 
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return 0;
@@ -1418,7 +1446,7 @@ Perl_debop(pTHX_ OP *o)
        if (cGVOPo_gv) {
            sv = NEWSV(0,0);
            gv_fullname3(sv, cGVOPo_gv, Nullch);
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
            SvREFCNT_dec(sv);
        }
        else