Oops. Fix bad #! lines when not using userelocatableinc
[p5sagit/p5-mst-13.2.git] / dump.c
diff --git a/dump.c b/dump.c
index e548585..0fcb0a6 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -423,11 +423,7 @@ STATIC void
 S_sequence(pTHX_ register const OP *o)
 {
     dVAR;
-    SV      *op;
-    const char *key;
-    STRLEN   len;
     const OP *oldop = NULL;
-    OP      *l;
 
     if (!o)
        return;
@@ -441,8 +437,10 @@ S_sequence(pTHX_ register const OP *o)
        Sequence = newHV();
 
     for (; o; o = o->op_next) {
-       op = newSVuv(PTR2UV(o));
-       key = SvPV_const(op, len);
+       STRLEN len;
+       SV * const op = newSVuv(PTR2UV(o));
+       const char * const key = SvPV_const(op, len);
+
        if (hv_exists(Sequence, key, len))
            break;
 
@@ -481,32 +479,22 @@ S_sequence(pTHX_ register const OP *o)
        case OP_COND_EXPR:
        case OP_RANGE:
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
-           for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
-               ;
-           sequence(l);
+           sequence_tail(cLOGOPo->op_other);
            break;
 
        case OP_ENTERLOOP:
        case OP_ENTERITER:
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
-           for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
-               ;
-           sequence(l);
-           for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next)
-               ;
-           sequence(l);
-           for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next)
-               ;
-           sequence(l);
+           sequence_tail(cLOOPo->op_redoop);
+           sequence_tail(cLOOPo->op_nextop);
+           sequence_tail(cLOOPo->op_lastop);
            break;
 
        case OP_QR:
        case OP_MATCH:
        case OP_SUBST:
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
-           for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
-               ;
-           sequence(l);
+           sequence_tail(cPMOPo->op_pmreplstart);
            break;
 
        case OP_HELEM:
@@ -520,6 +508,14 @@ S_sequence(pTHX_ register const OP *o)
     }
 }
 
+static void
+S_sequence_tail(pTHX_ const OP *o)
+{
+    while (o && (o->op_type == OP_NULL))
+       o = o->op_next;
+    sequence(o);
+}
+
 STATIC UV
 S_sequence_num(pTHX_ const OP *o)
 {
@@ -540,6 +536,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 {
     dVAR;
     UV      seq;
+    const OPCODE optype = o->op_type;
+
     sequence(o);
     Perl_dump_indent(aTHX_ level, file, "{\n");
     level++;
@@ -557,11 +555,9 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
-       if (o->op_type == OP_NULL)
-       {
+       if (optype == OP_NULL) {
            Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
-           if (o->op_targ == OP_NEXTSTATE)
-           {
+           if (o->op_targ == OP_NEXTSTATE) {
                if (CopLINE(cCOPo))
                    Perl_dump_indent(aTHX_ level, file, "LINE = %"UVf"\n",
                                     (UV)CopLINE(cCOPo));
@@ -580,7 +576,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
 #endif
     if (o->op_flags) {
-       SV *tmpsv = newSVpvs("");
+       SV * const tmpsv = newSVpvs("");
        switch (o->op_flags & OPf_WANT) {
        case OPf_WANT_VOID:
            sv_catpv(tmpsv, ",VOID");
@@ -611,27 +607,27 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
        SvREFCNT_dec(tmpsv);
     }
     if (o->op_private) {
-       SV *tmpsv = newSVpvs("");
-       if (PL_opargs[o->op_type] & OA_TARGLEX) {
+       SV * const tmpsv = newSVpvs("");
+       if (PL_opargs[optype] & OA_TARGLEX) {
            if (o->op_private & OPpTARGET_MY)
                sv_catpv(tmpsv, ",TARGET_MY");
        }
-       else if (o->op_type == OP_LEAVESUB ||
-                o->op_type == OP_LEAVE ||
-                o->op_type == OP_LEAVESUBLV ||
-                o->op_type == OP_LEAVEWRITE) {
+       else if (optype == OP_LEAVESUB ||
+                optype == OP_LEAVE ||
+                optype == OP_LEAVESUBLV ||
+                optype == OP_LEAVEWRITE) {
            if (o->op_private & OPpREFCOUNTED)
                sv_catpv(tmpsv, ",REFCOUNTED");
        }
-        else if (o->op_type == OP_AASSIGN) {
+        else if (optype == OP_AASSIGN) {
            if (o->op_private & OPpASSIGN_COMMON)
                sv_catpv(tmpsv, ",COMMON");
        }
-       else if (o->op_type == OP_SASSIGN) {
+       else if (optype == OP_SASSIGN) {
            if (o->op_private & OPpASSIGN_BACKWARDS)
                sv_catpv(tmpsv, ",BACKWARDS");
        }
-       else if (o->op_type == OP_TRANS) {
+       else if (optype == OP_TRANS) {
            if (o->op_private & OPpTRANS_SQUASH)
                sv_catpv(tmpsv, ",SQUASH");
            if (o->op_private & OPpTRANS_DELETE)
@@ -643,20 +639,20 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            if (o->op_private & OPpTRANS_GROWS)
                sv_catpv(tmpsv, ",GROWS");
        }
-       else if (o->op_type == OP_REPEAT) {
+       else if (optype == OP_REPEAT) {
            if (o->op_private & OPpREPEAT_DOLIST)
                sv_catpv(tmpsv, ",DOLIST");
        }
-       else if (o->op_type == OP_ENTERSUB ||
-                o->op_type == OP_RV2SV ||
-                o->op_type == OP_GVSV ||
-                o->op_type == OP_RV2AV ||
-                o->op_type == OP_RV2HV ||
-                o->op_type == OP_RV2GV ||
-                o->op_type == OP_AELEM ||
-                o->op_type == OP_HELEM )
+       else if (optype == OP_ENTERSUB ||
+                optype == OP_RV2SV ||
+                optype == OP_GVSV ||
+                optype == OP_RV2AV ||
+                optype == OP_RV2HV ||
+                optype == OP_RV2GV ||
+                optype == OP_AELEM ||
+                optype == OP_HELEM )
        {
-           if (o->op_type == OP_ENTERSUB) {
+           if (optype == OP_ENTERSUB) {
                if (o->op_private & OPpENTERSUB_AMPER)
                    sv_catpv(tmpsv, ",AMPER");
                if (o->op_private & OPpENTERSUB_DB)
@@ -685,7 +681,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                if (o->op_private & OPpMAYBE_LVSUB)
                    sv_catpv(tmpsv, ",MAYBE_LVSUB");
            }
-           if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
+           if (optype == OP_AELEM || optype == OP_HELEM) {
                if (o->op_private & OPpLVAL_DEFER)
                    sv_catpv(tmpsv, ",LVAL_DEFER");
            }
@@ -696,7 +692,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                    sv_catpv(tmpsv, ",OUR_INTRO");
            }
        }
-       else if (o->op_type == OP_CONST) {
+       else if (optype == OP_CONST) {
            if (o->op_private & OPpCONST_BARE)
                sv_catpv(tmpsv, ",BARE");
            if (o->op_private & OPpCONST_STRICT)
@@ -708,35 +704,35 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            if (o->op_private & OPpCONST_ENTERED)
                sv_catpv(tmpsv, ",ENTERED");
        }
-       else if (o->op_type == OP_FLIP) {
+       else if (optype == OP_FLIP) {
            if (o->op_private & OPpFLIP_LINENUM)
                sv_catpv(tmpsv, ",LINENUM");
        }
-       else if (o->op_type == OP_FLOP) {
+       else if (optype == OP_FLOP) {
            if (o->op_private & OPpFLIP_LINENUM)
                sv_catpv(tmpsv, ",LINENUM");
        }
-       else if (o->op_type == OP_RV2CV) {
+       else if (optype == OP_RV2CV) {
            if (o->op_private & OPpLVAL_INTRO)
                sv_catpv(tmpsv, ",INTRO");
        }
-       else if (o->op_type == OP_GV) {
+       else if (optype == OP_GV) {
            if (o->op_private & OPpEARLY_CV)
                sv_catpv(tmpsv, ",EARLY_CV");
        }
-       else if (o->op_type == OP_LIST) {
+       else if (optype == OP_LIST) {
            if (o->op_private & OPpLIST_GUESSED)
                sv_catpv(tmpsv, ",GUESSED");
        }
-       else if (o->op_type == OP_DELETE) {
+       else if (optype == OP_DELETE) {
            if (o->op_private & OPpSLICE)
                sv_catpv(tmpsv, ",SLICE");
        }
-       else if (o->op_type == OP_EXISTS) {
+       else if (optype == OP_EXISTS) {
            if (o->op_private & OPpEXISTS_SUB)
                sv_catpv(tmpsv, ",EXISTS_SUB");
        }
-       else if (o->op_type == OP_SORT) {
+       else if (optype == OP_SORT) {
            if (o->op_private & OPpSORT_NUMERIC)
                sv_catpv(tmpsv, ",NUMERIC");
            if (o->op_private & OPpSORT_INTEGER)
@@ -744,11 +740,11 @@ Perl_do_op_dump(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) {
+       else if (optype == OP_THREADSV) {
            if (o->op_private & OPpDONE_SVREF)
                sv_catpv(tmpsv, ",SVREF");
        }
-       else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
+       else if (optype == OP_OPEN || optype == OP_BACKTICK) {
            if (o->op_private & OPpOPEN_IN_RAW)
                sv_catpv(tmpsv, ",IN_RAW");
            if (o->op_private & OPpOPEN_IN_CRLF)
@@ -758,17 +754,17 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            if (o->op_private & OPpOPEN_OUT_CRLF)
                sv_catpv(tmpsv, ",OUT_CRLF");
        }
-       else if (o->op_type == OP_EXIT) {
+       else if (optype == OP_EXIT) {
            if (o->op_private & OPpEXIT_VMSISH)
                sv_catpv(tmpsv, ",EXIT_VMSISH");
            if (o->op_private & OPpHUSH_VMSISH)
                sv_catpv(tmpsv, ",HUSH_VMSISH");
        }
-       else if (o->op_type == OP_DIE) {
+       else if (optype == OP_DIE) {
            if (o->op_private & OPpHUSH_VMSISH)
                sv_catpv(tmpsv, ",HUSH_VMSISH");
        }
-       else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
+       else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
            if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
                sv_catpv(tmpsv, ",FT_ACCESS");
            if (o->op_private & OPpFT_STACKED)
@@ -824,7 +820,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     }
 #endif
 
-    switch (o->op_type) {
+    switch (optype) {
     case OP_AELEMFAST:
     case OP_GVSV:
     case OP_GV:
@@ -1241,15 +1237,19 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (HvREHASH(sv))       sv_catpv(d, "REHASH,");
        if (flags & SVphv_CLONEABLE) sv_catpv(d, "CLONEABLE,");
        break;
-    case SVt_PVGV: case SVt_PVLV:
-       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,");
+    case SVt_PVGV:
+    case SVt_PVLV:
+       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,");
+       }
        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 (GvIMPORTED(sv)) {
+       if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
            sv_catpv(d, "IMPORT");
            if (GvIMPORTED(sv) == GVf_IMPORTED)
                sv_catpv(d, "ALL,");
@@ -1448,7 +1448,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (HvARRAY(sv) && HvKEYS(sv)) {
            /* Show distribution of HEs in the ARRAY */
            int freq[200];
-#define FREQ_MAX (sizeof freq / sizeof freq[0] - 1)
+#define FREQ_MAX ((int)(sizeof freq / sizeof freq[0] - 1))
            int i;
            int max = 0;
            U32 pow2 = 2, keys = HvKEYS(sv);
@@ -1552,8 +1552,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        }
        break;
     case SVt_PVCV:
-       if (SvPOK(sv))
-           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV_nolen_const(sv));
+       if (SvPOK(sv)) {
+           STRLEN len;
+           const char *const proto =  SvPV_const(sv, len);
+           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%.*s\"\n",
+                            (int) len, proto);
+       }
        /* FALL THROUGH */
     case SVt_PVFM:
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
@@ -1609,7 +1613,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
            do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
        break;
-    case SVt_PVGV: case SVt_PVLV:
+    case SVt_PVGV:
+    case SVt_PVLV:
     if (type == SVt_PVLV) {
         Perl_dump_indent(aTHX_ level, file, "  TYPE = %c\n", LvTYPE(sv));
         Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv));
@@ -1619,11 +1624,11 @@ 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 (!isGV_with_GP(sv))
+           break;
        Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", GvNAME(sv));
        Perl_dump_indent(aTHX_ level, file, "  NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv));
        do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));
-       if (!isGV_with_GP(sv))
-           break;
        Perl_dump_indent(aTHX_ level, file, "  GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv)));
        if (!GvGP(sv))
            break;
@@ -2268,7 +2273,7 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     else
        Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
     if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
-       SV * const tmpsv = pmflags_description(pm);
+       SV * const tmpsv = pm_description(pm);
        Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
     }