Make parser_free() be called slightly later,

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

diff --git a/dump.c b/dump.c
index 6ececc9..544f9af 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -923,10 +923,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            if (o->op_private & OPpSORT_REVERSE)
                sv_catpv(tmpsv, ",REVERSE");
        }
-       else if (optype == OP_THREADSV) {
-           if (o->op_private & OPpDONE_SVREF)
-               sv_catpv(tmpsv, ",SVREF");
-       }
        else if (optype == OP_OPEN || optype == OP_BACKTICK) {
            if (o->op_private & OPpOPEN_IN_RAW)
                sv_catpv(tmpsv, ",IN_RAW");
@@ -1016,7 +1012,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                ENTER;
                SAVEFREESV(tmpsv);
 #ifdef PERL_MAD
-               /* FIXME - it this making unwarranted assumptions about the
+               /* FIXME - is this making unwarranted assumptions about the
                   UTF-8 cleanliness of the dump file handle?  */
                SvUTF8_on(tmpsv);
 #endif
@@ -1267,8 +1263,21 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
                Perl_dump_indent(aTHX_ level, file, "      MINMATCH\n");
         }
        if (mg->mg_obj) {
-           Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
-           if (mg->mg_flags & MGf_REFCOUNTED)
+           Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n", 
+               PTR2UV(mg->mg_obj));
+            if (mg->mg_type == PERL_MAGIC_qr) {
+                regexp *re=(regexp *)mg->mg_obj;
+                SV *dsv= sv_newmortal();
+                const char * const s =  pv_pretty(dsv, re->wrapped, re->wraplen, 
+                    60, NULL, NULL,
+                    ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELIPSES |
+                    ((re->extflags & RXf_UTF8) ? PERL_PV_ESCAPE_UNI : 0))
+                );
+               Perl_dump_indent(aTHX_ level+1, file, "    PAT = %s\n", s);
+               Perl_dump_indent(aTHX_ level+1, file, "    REFCNT = %"IVdf"\n",
+                       (IV)re->refcnt);
+            }
+            if (mg->mg_flags & MGf_REFCOUNTED)
                do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
        }
         if (mg->mg_len)
@@ -1394,6 +1403,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if (flags & SVf_OOK)       sv_catpv(d, "OOK,");
     if (flags & SVf_FAKE)      sv_catpv(d, "FAKE,");
     if (flags & SVf_READONLY)  sv_catpv(d, "READONLY,");
+    if (flags & SVf_BREAK)     sv_catpv(d, "BREAK,");
 
     if (flags & SVf_AMAGIC)    sv_catpv(d, "OVERLOAD,");
     if (flags & SVp_IOK)       sv_catpv(d, "pIOK,");
@@ -1528,7 +1538,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  COP_HIGH = %"UVuf"\n",
                         (UV) COP_SEQ_RANGE_HIGH(sv));
     } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
-               && type != SVt_PVCV && type != SVt_PVFM && !isGV_with_GP(sv))
+               && type != SVt_PVCV && type != SVt_PVFM && !isGV_with_GP(sv)
+               && !SvVALID(sv))
               || type == SVt_NV) {
        STORE_NUMERIC_LOCAL_SET_STANDARD();
        /* %Vg doesn't work? --jhi */
@@ -1565,8 +1576,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
     if (type >= SVt_PVMG) {
        if (type == SVt_PVMG && SvPAD_OUR(sv)) {
-           if (SvOURSTASH(sv))
-               do_hv_dump(level, file, "  OURSTASH", SvOURSTASH(sv));
+           HV *ost = SvOURSTASH(sv);
+           if (ost)
+               do_hv_dump(level, file, "  OURSTASH", ost);
        } else {
            if (SvMAGIC(sv))
                do_magic_dump(level, file, SvMAGIC(sv), nest, maxnest, dumpops, pvlim);
@@ -1783,6 +1795,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest,
                    dumpops, pvlim);
        }
+       if (SvVALID(sv)) {
+           Perl_dump_indent(aTHX_ level, file, "  FLAGS = %u\n", (U8)BmFLAGS(sv));
+           Perl_dump_indent(aTHX_ level, file, "  RARE = %u\n", (U8)BmRARE(sv));
+           Perl_dump_indent(aTHX_ level, file, "  PREVIOUS = %"UVuf"\n", (UV)BmPREVIOUS(sv));
+           Perl_dump_indent(aTHX_ level, file, "  USEFUL = %"IVdf"\n", (IV)BmUSEFUL(sv));
+       }
        if (!isGV_with_GP(sv))
            break;
        Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
@@ -1918,7 +1936,7 @@ Perl_debop(pTHX_ const OP *o)
        if (cGVOPo_gv) {
            SV * const sv = newSV(0);
 #ifdef PERL_MAD
-           /* FIXME - it this making unwarranted assumptions about the
+           /* FIXME - is this making unwarranted assumptions about the
               UTF-8 cleanliness of the dump file handle?  */
            SvUTF8_on(sv);
 #endif
@@ -2663,10 +2681,6 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
            if (o->op_private & OPpSORT_REVERSE)
                sv_catpv(tmpsv, ",REVERSE");
        }
-       else if (o->op_type == OP_THREADSV) {
-           if (o->op_private & OPpDONE_SVREF)
-               sv_catpv(tmpsv, ",SVREF");
-       }
        else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
            if (o->op_private & OPpOPEN_IN_RAW)
                sv_catpv(tmpsv, ",IN_RAW");