sv_uni_display(): do not add the "...", let the caller
[p5sagit/p5-mst-13.2.git] / dump.c
diff --git a/dump.c b/dump.c
index f23ac7b..b5e9fbf 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -104,42 +104,64 @@ Perl_dump_eval(pTHX)
 }
 
 char *
-Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
+Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 {
     int truncated = 0;
     int nul_terminated = len > cur && pv[cur] == '\0';
 
-    sv_setpvn(sv, "\"", 1);
+    sv_setpvn(dsv, "\"", 1);
     for (; cur--; pv++) {
-       if (pvlim && SvCUR(sv) >= pvlim) {
+       if (pvlim && SvCUR(dsv) >= pvlim) {
             truncated++;
            break;
         }
         if (isPRINT(*pv)) {
             switch (*pv) {
-           case '\t': sv_catpvn(sv, "\\t", 2);  break;
-           case '\n': sv_catpvn(sv, "\\n", 2);  break;
-           case '\r': sv_catpvn(sv, "\\r", 2);  break;
-           case '\f': sv_catpvn(sv, "\\f", 2);  break;
-           case '"':  sv_catpvn(sv, "\\\"", 2); break;
-           case '\\': sv_catpvn(sv, "\\\\", 2); break;
-           default:   sv_catpvn(sv, pv, 1);     break;
+           case '\t': sv_catpvn(dsv, "\\t", 2);  break;
+           case '\n': sv_catpvn(dsv, "\\n", 2);  break;
+           case '\r': sv_catpvn(dsv, "\\r", 2);  break;
+           case '\f': sv_catpvn(dsv, "\\f", 2);  break;
+           case '"':  sv_catpvn(dsv, "\\\"", 2); break;
+           case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+           default:   sv_catpvn(dsv, pv, 1);     break;
             }
         }
        else {
            if (cur && isDIGIT(*(pv+1)))
-               Perl_sv_catpvf(aTHX_ sv, "\\%03o", (U8)*pv);
+               Perl_sv_catpvf(aTHX_ dsv, "\\%03o", (U8)*pv);
            else
-               Perl_sv_catpvf(aTHX_ sv, "\\%o", (U8)*pv);
+               Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
         }
     }
-    sv_catpvn(sv, "\"", 1);
+    sv_catpvn(dsv, "\"", 1);
     if (truncated)
-       sv_catpvn(sv, "...", 3);
+       sv_catpvn(dsv, "...", 3);
     if (nul_terminated)
-       sv_catpvn(sv, "\\0", 2);
+       sv_catpvn(dsv, "\\0", 2);
 
-    return SvPVX(sv);
+    return SvPVX(dsv);
+}
+
+char *
+Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
+{
+    int truncated = 0;
+    char *s, *e;
+
+    sv_setpvn(dsv, "", 0);
+    for (s = SvPVX(ssv), e = s + SvCUR(ssv); 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 *
@@ -278,7 +300,8 @@ Perl_sv_peek(pTHX_ SV *sv)
                Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
            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]");
+               Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
+                              sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), 0));
            SvREFCNT_dec(tmp);
        }
     }
@@ -381,7 +404,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        PerlIO_printf(file, "    ");
     PerlIO_printf(file,
                  "%*sTYPE = %s  ===> ",
-                 (int)(PL_dumpindent*level-4), "", PL_op_name[o->op_type]);
+                 (int)(PL_dumpindent*level-4), "", OP_NAME(o));
     if (o->op_next) {
        if (o->op_seq)
            PerlIO_printf(file, "%d\n", o->op_next->op_seq);
@@ -392,7 +415,20 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
        if (o->op_type == OP_NULL)
+       {
            Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
+           if (o->op_targ == OP_NEXTSTATE)
+           {
+               if (CopLINE(cCOPo))
+                   Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo));
+               if (CopSTASHPV(cCOPo))
+                   Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
+                                    CopSTASHPV(cCOPo));
+               if (cCOPo->cop_label)
+                   Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
+                                    cCOPo->cop_label);
+           }
+       }
        else
            Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
     }
@@ -579,7 +615,13 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        }
        else if (o->op_type == OP_EXIT) {
            if (o->op_private & OPpEXIT_VMSISH)
-               sv_catpv(tmpsv, ",EXIST_VMSISH");
+               sv_catpv(tmpsv, ",EXIT_VMSISH");
+           if (o->op_private & OPpHUSH_VMSISH)
+               sv_catpv(tmpsv, ",HUSH_VMSISH");
+       }
+       else if (o->op_type == OP_DIE) {
+           if (o->op_private & OPpHUSH_VMSISH)
+               sv_catpv(tmpsv, ",HUSH_VMSISH");
        }
        if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
            sv_catpv(tmpsv, ",INTRO");
@@ -981,7 +1023,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     default:
        if (SvEVALED(sv))       sv_catpv(d, "EVALED,");
        if (SvIsUV(sv))         sv_catpv(d, "IsUV,");
-       if (SvUTF8(sv))         sv_catpv(d, "UTF8");
        break;
     case SVt_PVBM:
        if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
@@ -992,6 +1033,8 @@ 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))
+        sv_catpv(d, "UTF8");
 
     if (*(SvEND(d) - 1) == ',')
        SvPVX(d)[--SvCUR(d)] = '\0';
@@ -1089,7 +1132,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
            if (SvOOK(sv))
                PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
-           PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), 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, "\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));
        }
@@ -1177,8 +1223,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
               to the expected number needed for a random hash.
 
               The total number of comparisons is equal to the sum of
-              the squares of the number of entries in each backet.
-              For a random hash of n keys into k backets, the expected
+              the squares of the number of entries in each bucket.
+              For a random hash of n keys into k buckets, the expected
               value is
                                n + n(n-1)/2k
            */
@@ -1210,14 +1256,18 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 
            hv_iterinit(hv);
            while ((he = hv_iternext(hv)) && count--) {
-               SV *elt;
-               char *key;
-               I32 len;
+               SV *elt, *keysv;
+               char *keypv;
+               STRLEN len;
                U32 hash = HeHASH(he);
 
-               key = hv_iterkey(he, &len);
+               keysv = hv_iterkeysv(he);
+               keypv = SvPV(keysv, len);
                elt = hv_iterval(hv, he);
-               Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash);
+               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, "HASH = 0x%"UVxf"\n", (UV)hash);
                do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
            }
            hv_iterinit(hv);            /* Return to status quo */
@@ -1239,10 +1289,10 @@ 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_THREADS
+#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_THREADS */
+#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));