Update Changes.
[p5sagit/p5-mst-13.2.git] / dump.c
diff --git a/dump.c b/dump.c
index 03d731d..bbbcec3 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -60,8 +60,8 @@ Perl_dump_packsubs(pTHX_ HV *stash)
                dump_sub(gv);
            if (GvFORM(gv))
                dump_form(gv);
-           if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
-             (hv = GvHV(gv)) && HvNAME(hv) && hv != PL_defstash)
+           if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
+               && (hv = GvHV(gv)) && hv != PL_defstash)
                dump_packsubs(hv);              /* nested package */
        }
     }
@@ -436,7 +436,14 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
            if (o->op_private & OPpTARGET_MY)
                sv_catpv(tmpsv, ",TARGET_MY");
        }
-       if (o->op_type == OP_AASSIGN) {
+       else if (o->op_type == OP_LEAVESUB ||
+                o->op_type == OP_LEAVE ||
+                o->op_type == OP_LEAVESUBLV ||
+                o->op_type == OP_LEAVEWRITE) {
+           if (o->op_private & OPpREFCOUNTED)
+               sv_catpv(tmpsv, ",REFCOUNTED");
+       }
+        else if (o->op_type == OP_AASSIGN) {
            if (o->op_private & OPpASSIGN_COMMON)
                sv_catpv(tmpsv, ",COMMON");
            if (o->op_private & OPpASSIGN_HASH)
@@ -453,6 +460,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
                sv_catpv(tmpsv, ",DELETE");
            if (o->op_private & OPpTRANS_COMPLEMENT)
                sv_catpv(tmpsv, ",COMPLEMENT");
+           if (o->op_private & OPpTRANS_IDENTICAL)
+               sv_catpv(tmpsv, ",IDENTICAL");
+           if (o->op_private & OPpTRANS_GROWS)
+               sv_catpv(tmpsv, ",GROWS");
        }
        else if (o->op_type == OP_REPEAT) {
            if (o->op_private & OPpREPEAT_DOLIST)
@@ -474,8 +485,12 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
                    sv_catpv(tmpsv, ",DB");
                if (o->op_private & OPpENTERSUB_HASTARG)
                    sv_catpv(tmpsv, ",HASTARG");
+               if (o->op_private & OPpENTERSUB_NOPAREN)
+                   sv_catpv(tmpsv, ",NOPAREN");
+               if (o->op_private & OPpENTERSUB_INARGS)
+                   sv_catpv(tmpsv, ",INARGS");
            }
-           else
+           else {
                switch (o->op_private & OPpDEREF) {
            case OPpDEREF_SV:
                sv_catpv(tmpsv, ",SV");
@@ -487,6 +502,9 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
                sv_catpv(tmpsv, ",HV");
                break;
            }
+               if (o->op_private & OPpMAYBE_LVSUB)
+                   sv_catpv(tmpsv, ",MAYBE_LVSUB");
+           }
            if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
                if (o->op_private & OPpLVAL_DEFER)
                    sv_catpv(tmpsv, ",LVAL_DEFER");
@@ -503,6 +521,12 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
                sv_catpv(tmpsv, ",BARE");
            if (o->op_private & OPpCONST_STRICT)
                sv_catpv(tmpsv, ",STRICT");
+           if (o->op_private & OPpCONST_ARYBASE)
+               sv_catpv(tmpsv, ",ARYBASE");
+           if (o->op_private & OPpCONST_WARNING)
+               sv_catpv(tmpsv, ",WARNING");
+           if (o->op_private & OPpCONST_ENTERED)
+               sv_catpv(tmpsv, ",ENTERED");
        }
        else if (o->op_type == OP_FLIP) {
            if (o->op_private & OPpFLIP_LINENUM)
@@ -515,6 +539,48 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
            if (o->op_private & OPpLVAL_INTRO)
                sv_catpv(tmpsv, ",INTRO");
        }
+       else if (o->op_type == OP_GV) {
+           if (o->op_private & OPpEARLY_CV)
+               sv_catpv(tmpsv, ",EARLY_CV");
+       }
+       else if (o->op_type == OP_LIST) {
+           if (o->op_private & OPpLIST_GUESSED)
+               sv_catpv(tmpsv, ",GUESSED");
+       }
+       else if (o->op_type == OP_DELETE) {
+           if (o->op_private & OPpSLICE)
+               sv_catpv(tmpsv, ",SLICE");
+       }
+       else if (o->op_type == OP_EXISTS) {
+           if (o->op_private & OPpEXISTS_SUB)
+               sv_catpv(tmpsv, ",EXISTS_SUB");
+       }
+       else if (o->op_type == OP_SORT) {
+           if (o->op_private & OPpSORT_NUMERIC)
+               sv_catpv(tmpsv, ",NUMERIC");
+           if (o->op_private & OPpSORT_INTEGER)
+               sv_catpv(tmpsv, ",INTEGER");
+           if (o->op_private & OPpSORT_REVERSE)
+               sv_catpv(tmpsv, ",REVERSE");
+       }
+       else if (o->op_type == OP_THREADSV) {
+           if (o->op_private & OPpDONE_SVREF)
+               sv_catpv(tmpsv, ",SVREF");
+       }
+       else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
+           if (o->op_private & OPpOPEN_IN_RAW)
+               sv_catpv(tmpsv, ",IN_RAW");
+           if (o->op_private & OPpOPEN_IN_CRLF)
+               sv_catpv(tmpsv, ",IN_CRLF");
+           if (o->op_private & OPpOPEN_OUT_RAW)
+               sv_catpv(tmpsv, ",OUT_RAW");
+           if (o->op_private & OPpOPEN_OUT_CRLF)
+               sv_catpv(tmpsv, ",OUT_CRLF");
+       }
+       else if (o->op_type == OP_EXIT) {
+           if (o->op_private & OPpEXIT_VMSISH)
+               sv_catpv(tmpsv, ",EXIST_VMSISH");
+       }
        if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
            sv_catpv(tmpsv, ",INTRO");
        if (SvCUR(tmpsv))
@@ -640,6 +706,50 @@ Perl_gv_dump(pTHX_ GV *gv)
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
 }
 
+
+/* map magic types to the symbolic name
+ * (with the PERL_MAGIC_ prefixed stripped)
+ */
+
+static struct { char type; char *name; } magic_names[] = {
+       { PERL_MAGIC_sv,             "sv(\\0)" },
+       { PERL_MAGIC_arylen,         "arylen(#)" },
+       { PERL_MAGIC_glob,           "glob(*)" },
+       { PERL_MAGIC_pos,            "pos(.)" },
+       { PERL_MAGIC_backref,        "backref(<)" },
+       { PERL_MAGIC_overload,       "overload(A)" },
+       { PERL_MAGIC_bm,             "bm(B)" },
+       { PERL_MAGIC_regdata,        "regdata(D)" },
+       { PERL_MAGIC_env,            "env(E)" },
+       { PERL_MAGIC_isa,            "isa(I)" },
+       { PERL_MAGIC_dbfile,         "dbfile(L)" },
+       { PERL_MAGIC_tied,           "tied(P)" },
+       { PERL_MAGIC_sig,            "sig(S)" },
+       { PERL_MAGIC_uvar,           "uvar(U)" },
+       { PERL_MAGIC_overload_elem,  "overload_elem(a)" },
+       { PERL_MAGIC_overload_table, "overload_table(c)" },
+       { PERL_MAGIC_regdatum,       "regdatum(d)" },
+       { PERL_MAGIC_envelem,        "envelem(e)" },
+       { PERL_MAGIC_fm,             "fm(f)" },
+       { PERL_MAGIC_regex_global,   "regex_global(g)" },
+       { PERL_MAGIC_isaelem,        "isaelem(i)" },
+       { PERL_MAGIC_nkeys,          "nkeys(k)" },
+       { PERL_MAGIC_dbline,         "dbline(l)" },
+       { PERL_MAGIC_mutex,          "mutex(m)" },
+       { PERL_MAGIC_collxfrm,       "collxfrm(o)" },
+       { PERL_MAGIC_tiedelem,       "tiedelem(p)" },
+       { PERL_MAGIC_tiedscalar,     "tiedscalar(q)" },
+       { PERL_MAGIC_qr,             "qr(r)" },
+       { PERL_MAGIC_sigelem,        "sigelem(s)" },
+       { PERL_MAGIC_taint,          "taint(t)" },
+       { PERL_MAGIC_vec,            "vec(v)" },
+       { PERL_MAGIC_substr,         "substr(x)" },
+       { PERL_MAGIC_defelem,        "defelem(y)" },
+       { PERL_MAGIC_ext,            "ext(~)" },
+       /* this null string terminates the list */
+       { 0,                         0 },
+};
+
 void
 Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
@@ -687,10 +797,22 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
        if (mg->mg_private)
            Perl_dump_indent(aTHX_ level, file, "    MG_PRIVATE = %d\n", mg->mg_private);
 
-       if (isPRINT(mg->mg_type))
-           Perl_dump_indent(aTHX_ level, file, "    MG_TYPE = '%c'\n", mg->mg_type);
-       else
-           Perl_dump_indent(aTHX_ level, file, "    MG_TYPE = '\\%o'\n", mg->mg_type);
+       {
+           int n;
+           char *name = 0;
+           for (n=0; magic_names[n].name; n++) {
+               if (mg->mg_type == magic_names[n].type) {
+                   name = magic_names[n].name;
+                   break;
+               }
+           }
+           if (name)
+               Perl_dump_indent(aTHX_ level, file,
+                               "    MG_TYPE = PERL_MAGIC_%s\n", name);
+           else
+               Perl_dump_indent(aTHX_ level, file,
+                               "    MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type);
+       }
 
         if (mg->mg_flags) {
             Perl_dump_indent(aTHX_ level, file, "    MG_FLAGS = 0x%02X\n", mg->mg_flags);
@@ -761,7 +883,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv)
     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
     if (sv && GvNAME(sv)) {
        PerlIO_printf(file, "\t\"");
-       if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
+       if (GvSTASH(sv))
            PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv)));
        PerlIO_printf(file, "%s\"\n", GvNAME(sv));
     }