Re: Named-capture regex syntax

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

diff --git a/dump.c b/dump.c
index 4d86d25..eefa477 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -32,11 +32,11 @@ static const char* const svtypenames[SVt_LAST] = {
     "IV",
     "NV",
     "RV",
+    "BIND",
     "PV",
     "PVIV",
     "PVNV",
     "PVMG",
-    "PVBM",
     "PVGV",
     "PVLV",
     "PVAV",
@@ -52,11 +52,11 @@ static const char* const svshorttypenames[SVt_LAST] = {
     "IV",
     "NV",
     "RV",
+    "BIND",
     "PV",
     "PVIV",
     "PVNV",
     "PVMG",
-    "BM",
     "GV",
     "PVLV",
     "AV",
@@ -739,7 +739,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #ifdef DUMPADDR
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
 #endif
-    if (o->op_flags) {
+    if (o->op_flags || o->op_latefree || o->op_latefreed) {
        SV * const tmpsv = newSVpvs("");
        switch (o->op_flags & OPf_WANT) {
        case OPf_WANT_VOID:
@@ -767,6 +767,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            sv_catpv(tmpsv, ",MOD");
        if (o->op_flags & OPf_SPECIAL)
            sv_catpv(tmpsv, ",SPECIAL");
+       if (o->op_latefree)
+           sv_catpv(tmpsv, ",LATEFREE");
+       if (o->op_latefreed)
+           sv_catpv(tmpsv, ",LATEFREED");
        Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
     }
@@ -1353,9 +1357,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                   (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
                   (int)(PL_dumpindent*level), "");
 
-    if (flags & SVs_PADSTALE)  sv_catpv(d, "PADSTALE,");
-    if (flags & SVs_PADTMP)    sv_catpv(d, "PADTMP,");
-    if (flags & SVs_PADMY)     sv_catpv(d, "PADMY,");
+    if (!(flags & SVpad_NAME && (type == SVt_PVMG || type == SVt_PVNV))) {
+       if (flags & SVs_PADSTALE)       sv_catpv(d, "PADSTALE,");
+    }
+    if (!(flags & SVpad_NAME && type == SVt_PVMG)) {
+       if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,");
+       if (flags & SVs_PADMY)  sv_catpv(d, "PADMY,");
+    }
     if (flags & SVs_TEMP)      sv_catpv(d, "TEMP,");
     if (flags & SVs_OBJECT)    sv_catpv(d, "OBJECT,");
     if (flags & SVs_GMG)       sv_catpv(d, "GMG,");
@@ -1377,8 +1385,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if (flags & SVp_IOK)       sv_catpv(d, "pIOK,");
     if (flags & SVp_NOK)       sv_catpv(d, "pNOK,");
     if (flags & SVp_POK)       sv_catpv(d, "pPOK,");
-    if (flags & SVp_SCREAM && type != SVt_PVHV)
+    if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
+       if (SvPCS_IMPORTED(sv))
+                               sv_catpv(d, "PCS_IMPORTED,");
+       else
                                sv_catpv(d, "SCREAM,");
+    }
 
     switch (type) {
     case SVt_PVCV:
@@ -1412,9 +1424,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
            if (GvIN_PAD(sv))   sv_catpv(d, "IN_PAD,");
        }
-       if (SvPAD_OUR(sv))      sv_catpv(d, "OUR,");
-       if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
-       if (SvPAD_TYPED(sv))    sv_catpv(d, "TYPED,");
        if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
            sv_catpv(d, "IMPORT");
            if (GvIMPORTED(sv) == GVf_IMPORTED)
@@ -1428,18 +1437,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                sv_catpv(d, " ),");
            }
        }
+       if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
+       if (SvVALID(sv))        sv_catpv(d, "VALID,");
        /* FALL THROUGH */
     default:
+    evaled_or_uv:
        if (SvEVALED(sv))       sv_catpv(d, "EVALED,");
        if (SvIsUV(sv) && !(flags & SVf_ROK))   sv_catpv(d, "IsUV,");
        break;
-    case SVt_PVBM:
-       if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
-       if (SvVALID(sv))        sv_catpv(d, "VALID,");
-       break;
     case SVt_PVMG:
        if (SvPAD_TYPED(sv))    sv_catpv(d, "TYPED,");
+       if (SvPAD_OUR(sv))      sv_catpv(d, "OUR,");
+       if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
        break;
+    case SVt_PVNV:
+       if (SvPAD_STATE(sv))    sv_catpv(d, "STATE,");
+       goto evaled_or_uv;
     case SVt_PVAV:
        break;
     }
@@ -2334,8 +2347,8 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     case SVt_PVGV:
        sv_catpv(t, " GV=\"");
        break;
-    case SVt_PVBM:
-       sv_catpv(t, " BM=\"");
+    case SVt_BIND:
+       sv_catpv(t, " BIND=\"");
        break;
     case SVt_PVFM:
        sv_catpv(t, " FM=\"");
@@ -2384,7 +2397,7 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     level++;
     if (PM_GETRE(pm)) {
        char *s = PM_GETRE(pm)->precomp;
-       SV *tmpsv = newSV(0);
+       SV *tmpsv = newSVpvn("",0);
        SvUTF8_on(tmpsv);
        sv_catxmlpvn(tmpsv, s, strlen(s), 1);
        Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
@@ -2676,7 +2689,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #else
        if (cSVOPo->op_sv) {
            SV *tmpsv1 = newSV(0);
-           SV *tmpsv2 = newSV(0);
+           SV *tmpsv2 = newSVpvn("",0);
            char *s;
            STRLEN len;
            SvUTF8_on(tmpsv1);