X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=48a3b38468ce9d1c72f0f7fa5384756d896ca56a;hb=126f3c5f1f20a40de59db499161effaa9e24e4fc;hp=0ac6b0ce1d3be46c1062f67fa4951cd49c3a6695;hpb=bd16a5f0b030a6752676e07b488b3ba891d6e8f7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index 0ac6b0c..48a3b38 100644
--- a/dump.c
+++ b/dump.c
@@ -1,6 +1,6 @@
 /*    dump.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -143,35 +143,6 @@ Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 }
 
 char *
-Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
-{
-    int truncated = 0;
-    char *s, *e;
-
-    sv_setpvn(dsv, "", 0);
-    for (s = (char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) {
-	 UV u;
-	 if (pvlim && SvCUR(dsv) >= pvlim) {
-	      truncated++;
-	      break;
-	 }
-	 u = utf8_to_uvchr((U8*)s, 0);
-	 Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u);
-    }
-    if (truncated)
-	 sv_catpvn(dsv, "...", 3);
-    
-    return SvPVX(dsv);
-}
-
-char *
-Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
-{
-  return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv),
-			     pvlim, flags);
-}
-
-char *
 Perl_sv_peek(pTHX_ SV *sv)
 {
     SV *t = sv_newmortal();
@@ -308,13 +279,14 @@ Perl_sv_peek(pTHX_ SV *sv)
 	    Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
 	    if (SvUTF8(sv))
 		Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
-			       sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), 0));
+			       sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv),
+					      UNI_DISPLAY_QQ));
 	    SvREFCNT_dec(tmp);
 	}
     }
     else if (SvNOKp(sv)) {
 	STORE_NUMERIC_LOCAL_SET_STANDARD();
-	Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv));
+	Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     }
     else if (SvIOKp(sv)) {
@@ -532,6 +504,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 		    sv_catpv(tmpsv, ",NOPAREN");
 		if (o->op_private & OPpENTERSUB_INARGS)
 		    sv_catpv(tmpsv, ",INARGS");
+		if (o->op_private & OPpENTERSUB_NOMOD)
+		    sv_catpv(tmpsv, ",NOMOD");
 	    }
 	    else {
 		switch (o->op_private & OPpDEREF) {
@@ -578,7 +552,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 	else if (o->op_type == OP_FLOP) {
 	    if (o->op_private & OPpFLIP_LINENUM)
 		sv_catpv(tmpsv, ",LINENUM");
-	} else if (o->op_type == OP_RV2CV) {
+	}
+	else if (o->op_type == OP_RV2CV) {
 	    if (o->op_private & OPpLVAL_INTRO)
 		sv_catpv(tmpsv, ",INTRO");
 	}
@@ -1005,6 +980,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     case SVt_PVHV:
 	if (HvSHAREKEYS(sv))	sv_catpv(d, "SHAREKEYS,");
 	if (HvLAZYDEL(sv))	sv_catpv(d, "LAZYDEL,");
+	if (HvUTF8KEYS(sv))	sv_catpv(d, "UTF8,");
 	break;
     case SVt_PVGV:
 	if (GvINTRO(sv))	sv_catpv(d, "INTRO,");
@@ -1141,7 +1117,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 		PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
 	    PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
 	    if (SvUTF8(sv)) /* the 8?  \x{....} */
-	        PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), 0));
+	        PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
 	    PerlIO_printf(file, "\n");
 	    Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
 	    Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n", (IV)SvLEN(sv));
@@ -1273,7 +1249,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 		elt = hv_iterval(hv, he);
 		Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
 		if (SvUTF8(keysv))
-		    PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), 0));
+		    PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
 		PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
 		do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
 	    }
@@ -1398,7 +1374,7 @@ Perl_runops_debug(pTHX)
 {
     if (!PL_op) {
 	if (ckWARN_d(WARN_DEBUGGING))
-	    Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
+	    Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
 	return 0;
     }
 
@@ -1410,7 +1386,7 @@ Perl_runops_debug(pTHX)
 			      "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
 			      PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
 			      PTR2UV(*PL_watchaddr));
-	    if (DEBUG_p_TEST_) debstack();
+	    if (DEBUG_s_TEST_) debstack();
 	    if (DEBUG_t_TEST_) debop(PL_op);
 	    if (DEBUG_P_TEST_) debprof(PL_op);
 	}
@@ -1427,6 +1403,10 @@ Perl_debop(pTHX_ OP *o)
     CV *cv;
     SV *sv;
     STRLEN n_a;
+
+    if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+	return 0;
+
     Perl_deb(aTHX_ "%s", OP_NAME(o));
     switch (o->op_type) {
     case OP_CONST:
@@ -1494,6 +1474,8 @@ Perl_watch(pTHX_ char **addr)
 STATIC void
 S_debprof(pTHX_ OP *o)
 {
+    if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+	return;
     if (!PL_profiledata)
 	Newz(000, PL_profiledata, MAXO, U32);
     ++PL_profiledata[o->op_type];