X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=5dc1e5cb3d5500e459d2d0860e49967150486e90;hb=e9f19e3c03f1d62dc32ee20c3f9cd088c9618f14;hp=7f82fad98639236c6c40559479b0e44781224528;hpb=afe3852089dde68b99096e1e00a604b53259fbd1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index 7f82fad..5dc1e5c 100644
--- a/dump.c
+++ b/dump.c
@@ -461,8 +461,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
         else if (o->op_type == OP_AASSIGN) {
 	    if (o->op_private & OPpASSIGN_COMMON)
 		sv_catpv(tmpsv, ",COMMON");
-	    if (o->op_private & OPpASSIGN_HASH)
-		sv_catpv(tmpsv, ",HASH");
 	}
 	else if (o->op_type == OP_SASSIGN) {
 	    if (o->op_private & OPpASSIGN_BACKWARDS)
@@ -770,6 +768,7 @@ static struct { char type; char *name; } magic_names[] = {
 	{ PERL_MAGIC_taint,          "taint(t)" },
 	{ PERL_MAGIC_uvar_elem,      "uvar_elem(v)" },
 	{ PERL_MAGIC_vec,            "vec(v)" },
+	{ PERL_MAGIC_vstring,        "vstring(V)" },
 	{ PERL_MAGIC_substr,         "substr(x)" },
 	{ PERL_MAGIC_defelem,        "defelem(y)" },
 	{ PERL_MAGIC_ext,            "ext(~)" },
@@ -843,13 +842,15 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
 
         if (mg->mg_flags) {
             Perl_dump_indent(aTHX_ level, file, "    MG_FLAGS = 0x%02X\n", mg->mg_flags);
-	    if (mg->mg_flags & MGf_TAINTEDDIR)
+	    if (mg->mg_type == PERL_MAGIC_envelem &&
+		mg->mg_flags & MGf_TAINTEDDIR)
 	        Perl_dump_indent(aTHX_ level, file, "      TAINTEDDIR\n");
 	    if (mg->mg_flags & MGf_REFCOUNTED)
 	        Perl_dump_indent(aTHX_ level, file, "      REFCOUNTED\n");
             if (mg->mg_flags & MGf_GSKIP)
 	        Perl_dump_indent(aTHX_ level, file, "      GSKIP\n");
-	    if (mg->mg_flags & MGf_MINMATCH)
+	    if (mg->mg_type == PERL_MAGIC_regex_global &&
+		mg->mg_flags & MGf_MINMATCH)
 	        Perl_dump_indent(aTHX_ level, file, "      MINMATCH\n");
         }
 	if (mg->mg_obj) {
@@ -979,6 +980,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	if (SvCOMPILED(sv))	sv_catpv(d, "COMPILED,");
 	if (CvLVALUE(sv))	sv_catpv(d, "LVALUE,");
 	if (CvMETHOD(sv))	sv_catpv(d, "METHOD,");
+	if (CvLOCKED(sv))	sv_catpv(d, "LOCKED,");
 	break;
     case SVt_PVHV:
 	if (HvSHAREKEYS(sv))	sv_catpv(d, "SHAREKEYS,");
@@ -1019,7 +1021,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 				sv_catpv(d, "TYPED,");
 	break;
     }
-    if (SvPOK(sv) && SvUTF8(sv))
+    if ((SvPOK(sv) || SvPOKp(sv)) && SvUTF8(sv))
         sv_catpv(d, "UTF8");
 
     if (*(SvEND(d) - 1) == ',')
@@ -1084,12 +1086,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	return;
     }
     if (type >= SVt_PVIV || type == SVt_IV) {
-	if (SvIsUV(sv))
+	if (SvIsUV(sv)
+#ifdef PERL_COPY_ON_WRITE
+	               || SvIsCOW(sv)
+#endif
+	                             )
 	    Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
 	else
 	    Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
 	if (SvOOK(sv))
 	    PerlIO_printf(file, "  (OFFSET)");
+#ifdef PERL_COPY_ON_WRITE
+	if (SvIsCOW_shared_hash(sv))
+	    PerlIO_printf(file, "  (HASH)");
+	else if (SvIsCOW_normal(sv))
+	    PerlIO_printf(file, "  (COW from 0x%"UVxf")", (UV)SvUVX(sv));
+#endif
 	PerlIO_putc(file, '\n');
     }
     if (type >= SVt_PVNV || type == SVt_NV) {
@@ -1276,34 +1288,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
  	do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
 	Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
 	Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
-#ifdef USE_5005THREADS
-	Perl_dump_indent(aTHX_ level, file, "  MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
-	Perl_dump_indent(aTHX_ level, file, "  OWNER = 0x%"UVxf"\n",  PTR2UV(CvOWNER(sv)));
-#endif /* USE_5005THREADS */
 	Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(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)));
-	if (nest < maxnest && CvPADLIST(sv)) {
-	    AV* padlist = CvPADLIST(sv);
-	    AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
-	    AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
-	    SV** pname = AvARRAY(pad_name);
-	    SV** ppad = AvARRAY(pad);
-	    I32 ix;
-
-	    for (ix = 1; ix <= AvFILL(pad_name); ix++) {
-		if (SvPOK(pname[ix]))
-		    Perl_dump_indent(aTHX_ level,
-				/* %5d below is enough whitespace. */
-				file,
-				"%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
-				(int)ix, PTR2UV(ppad[ix]),
-				SvFAKE(pname[ix]) ? "FAKE " : "",
-				SvPVX(pname[ix]),
-				(IV)SvNVX(pname[ix]),
-				(IV)SvIVX(pname[ix]));
-	    }
+	if (nest < maxnest) {
+	    do_dump_pad(level+1, file, CvPADLIST(sv), 0);
 	}
 	{
 	    CV *outside = CvOUTSIDE(sv);
@@ -1390,7 +1380,16 @@ Perl_runops_debug(pTHX)
 			      "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
 			      PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
 			      PTR2UV(*PL_watchaddr));
-	    if (DEBUG_s_TEST_) debstack();
+	    if (DEBUG_s_TEST_) {
+		if (DEBUG_v_TEST_) {
+		    PerlIO_printf(Perl_debug_log, "\n");
+		    deb_stack_all();
+		}
+		else
+		    debstack();
+	    }
+
+
 	    if (DEBUG_t_TEST_) debop(PL_op);
 	    if (DEBUG_P_TEST_) debprof(PL_op);
 	}