X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=1dc557122da89c93db8c1991a219849684fa55cc;hb=d2d73c3ec87c4412e7e67142070015e92c5112b0;hp=1b51b49cce52549297202ca78bd3cc1a4e624e2d;hpb=bf91b999b25fa75a3ef7a327742929592a2e7e9c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index 1b51b49..1dc5571 100644
--- 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 */
 	}
     }
@@ -706,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)
 {
@@ -753,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);
@@ -827,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));
     }
@@ -907,6 +963,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	if (GvSHARED(sv))       sv_catpv(d, "SHARED,");
 	if (GvASSUMECV(sv))	sv_catpv(d, "ASSUMECV,");
 	if (GvIN_PAD(sv))       sv_catpv(d, "IN_PAD,");
+	if (flags & SVpad_OUR)	sv_catpv(d, "OUR,");
 	if (GvIMPORTED(sv)) {
 	    sv_catpv(d, "IMPORT");
 	    if (GvIMPORTED(sv) == GVf_IMPORTED)
@@ -920,7 +977,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 		sv_catpv(d, " ),");
 	    }
 	}
-	/* FALL THROGH */
+	/* FALL THROUGH */
     default:
 	if (SvEVALED(sv))	sv_catpv(d, "EVALED,");
 	if (SvIsUV(sv))		sv_catpv(d, "IsUV,");
@@ -930,6 +987,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	if (SvTAIL(sv))		sv_catpv(d, "TAIL,");
 	if (SvVALID(sv))	sv_catpv(d, "VALID,");
 	break;
+    case SVt_PVMG:
+	if (flags & SVpad_TYPED)
+				sv_catpv(d, "TYPED,");
+	break;
     }
 
     if (*(SvEND(d) - 1) == ',')