abd39864 broke t/harness when $ENV{TEST_JOBS} was not set. Oops. Fixed.

[p5sagit/p5-mst-13.2.git] / dump.c

diff --git a/dump.c b/dump.c
index 724baf8..c891b2f 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -505,8 +505,11 @@ Perl_sv_peek(pTHX_ SV *sv)
        else {
            SV * const tmp = newSVpvs("");
            sv_catpv(t, "(");
-           if (SvOOK(sv))
-               Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
+           if (SvOOK(sv)) {
+               STRLEN delta;
+               SvOOK_offset(sv, delta);
+               Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127));
+           }
            Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
            if (SvUTF8(sv))
                Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
@@ -1040,7 +1043,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #ifdef USE_ITHREADS
        Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix);
 #else
-       if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
+       if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
            if (cSVOPo->op_sv) {
                SV * const tmpsv = newSV(0);
                ENTER;
@@ -1258,6 +1261,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
            else if (v == &PL_vtbl_utf8)       s = "utf8";
             else if (v == &PL_vtbl_arylen_p)   s = "arylen_p";
             else if (v == &PL_vtbl_hintselem)  s = "hintselem";
+            else if (v == &PL_vtbl_hints)      s = "hints";
            else                               s = NULL;
            if (s)
                Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
@@ -1477,7 +1481,6 @@ 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,");
        if (CvWEAKOUTSIDE(sv))  sv_catpv(d, "WEAKOUTSIDE,");
        break;
     case SVt_PVHV:
@@ -1492,7 +1495,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (isGV_with_GP(sv)) {
            if (GvINTRO(sv))    sv_catpv(d, "INTRO,");
            if (GvMULTI(sv))    sv_catpv(d, "MULTI,");
-           if (GvUNIQUE(sv))   sv_catpv(d, "UNIQUE,");
            if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
            if (GvIN_PAD(sv))   sv_catpv(d, "IN_PAD,");
        }
@@ -1752,12 +1754,48 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (SvOOK(sv)) {
            AV * const backrefs
                = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
+           struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta;
            if (backrefs) {
                Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
                                 PTR2UV(backrefs));
                do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
                           dumpops, pvlim);
            }
+           if (meta) {
+               /* FIXME - mro_algs kflags can signal a UTF-8 name.  */
+               Perl_dump_indent(aTHX_ level, file, "  MRO_WHICH = \"%.*s\" (0x%"UVxf")\n",
+                                (int)meta->mro_which->length,
+                                meta->mro_which->name,
+                                PTR2UV(meta->mro_which));
+               Perl_dump_indent(aTHX_ level, file, "  CACHE_GEN = 0x%"UVxf"\n",
+                                (UV)meta->cache_gen);
+               Perl_dump_indent(aTHX_ level, file, "  PKG_GEN = 0x%"UVxf"\n",
+                                (UV)meta->pkg_gen);
+               if (meta->mro_linear_all) {
+                   Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_ALL = 0x%"UVxf"\n",
+                                PTR2UV(meta->mro_linear_all));
+               do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest,
+                          dumpops, pvlim);
+               }
+               if (meta->mro_linear_current) {
+                   Perl_dump_indent(aTHX_ level, file, "  MRO_LINEAR_CURRENT = 0x%"UVxf"\n",
+                                PTR2UV(meta->mro_linear_current));
+               do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest,
+                          dumpops, pvlim);
+               }
+               if (meta->mro_nextmethod) {
+                   Perl_dump_indent(aTHX_ level, file, "  MRO_NEXTMETHOD = 0x%"UVxf"\n",
+                                PTR2UV(meta->mro_nextmethod));
+               do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest,
+                          dumpops, pvlim);
+               }
+               if (meta->isa) {
+                   Perl_dump_indent(aTHX_ level, file, "  ISA = 0x%"UVxf"\n",
+                                PTR2UV(meta->isa));
+               do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest,
+                          dumpops, pvlim);
+               }
+           }
        }
        if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
            HE *he;