PERL_EFF_ACCESS_[RWX]_OK can go.

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index c820687..9dc7db8 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -80,7 +80,7 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
 void
 Perl_dump_sub(pTHX_ const GV *gv)
 {
-    SV *sv = sv_newmortal();
+    SV * const sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
@@ -97,7 +97,7 @@ Perl_dump_sub(pTHX_ const GV *gv)
 void
 Perl_dump_form(pTHX_ const GV *gv)
 {
-    SV *sv = sv_newmortal();
+    SV * const sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
@@ -154,8 +154,7 @@ char *
 Perl_sv_peek(pTHX_ SV *sv)
 {
     dVAR;
-    SV *t = sv_newmortal();
-    STRLEN n_a;
+    SV * const t = sv_newmortal();
     int unref = 0;
 
     sv_setpvn(t, "", 0);
@@ -331,7 +330,7 @@ Perl_sv_peek(pTHX_ SV *sv)
        while (unref--)
            sv_catpv(t, ")");
     }
-    return SvPV(t, n_a);
+    return SvPV_nolen(t);
 }
 
 void
@@ -407,7 +406,7 @@ sequence(pTHX_ register const OP *o)
 {
     dVAR;
     SV      *op;
-    char    *key;
+    const char *key;
     STRLEN   len;
     const OP *oldop = 0;
     OP      *l;
@@ -415,14 +414,12 @@ sequence(pTHX_ register const OP *o)
     if (!o)
        return;
 
-    op = newSVuv(PTR2UV(o));
-    key = SvPV(op, len);
-    if (hv_exists(Sequence, key, len))
-       return;
+    if (!Sequence)
+       Sequence = newHV();
 
     for (; o; o = o->op_next) {
        op = newSVuv(PTR2UV(o));
-       key = SvPV(op, len);
+       key = SvPV_const(op, len);
        if (hv_exists(Sequence, key, len))
            break;
 
@@ -502,11 +499,11 @@ sequence_num(pTHX_ const OP *o)
     dVAR;
     SV     *op,
           **seq;
-    char   *key;
+    const char *key;
     STRLEN  len;
     if (!o) return 0;
     op = newSVuv(PTR2UV(o));
-    key = SvPV(op, len);
+    key = SvPV_const(op, len);
     seq = hv_fetch(Sequence, key, len, 0);
     return seq ? SvUV(*seq): 0;
 }
@@ -767,11 +764,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
        if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */
            if (cSVOPo->op_sv) {
                SV *tmpsv = NEWSV(0,0);
-               STRLEN n_a;
                ENTER;
                SAVEFREESV(tmpsv);
                gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
-               Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
+               Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
+                                SvPV_nolen_const(tmpsv));
                LEAVE;
            }
            else
@@ -895,6 +892,7 @@ static const struct { const char type; const char *name; } magic_names[] = {
        { PERL_MAGIC_pos,            "pos(.)" },
        { PERL_MAGIC_symtab,         "symtab(:)" },
        { PERL_MAGIC_backref,        "backref(<)" },
+       { PERL_MAGIC_arylen_p,       "arylen_p(@)" },
        { PERL_MAGIC_overload,       "overload(A)" },
        { PERL_MAGIC_bm,             "bm(B)" },
        { PERL_MAGIC_regdata,        "regdata(D)" },
@@ -970,6 +968,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
            else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
            else if (v == &PL_vtbl_backref)    s = "backref";
            else if (v == &PL_vtbl_utf8)       s = "utf8";
+            else if (v == &PL_vtbl_arylen_p)   s = "arylen_p";
            if (s)
                Perl_dump_indent(aTHX_ level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
            else
@@ -1189,7 +1188,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        /* FALL THROUGH */
     default:
        if (SvEVALED(sv))       sv_catpv(d, "EVALED,");
-       if (SvIsUV(sv))         sv_catpv(d, "IsUV,");
+       if (SvIsUV(sv) && !(flags & SVf_ROK))   sv_catpv(d, "IsUV,");
        break;
     case SVt_PVBM:
        if (SvTAIL(sv))         sv_catpv(d, "TAIL,");
@@ -1280,7 +1279,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV)
        || type == SVt_IV) {
        if (SvIsUV(sv)
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
                       || SvIsCOW(sv)
 #endif
                                     )
@@ -1289,7 +1288,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
        if (SvOOK(sv))
            PerlIO_printf(file, "  (OFFSET)");
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW_shared_hash(sv))
            PerlIO_printf(file, "  (HASH)");
        else if (SvIsCOW_normal(sv))
@@ -1349,7 +1348,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            PerlIO_putc(file, '\n');
        Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
-       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv)));
+       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
        sv_setpvn(d, "", 0);
        if (AvREAL(sv)) sv_catpv(d, ",REAL");
        if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
@@ -1451,7 +1450,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                U32 hash = HeHASH(he);
 
                keysv = hv_iterkeysv(he);
-               keypv = SvPV(keysv, len);
+               keypv = SvPV_const(keysv, len);
                elt = hv_iterval(hv, he);
                Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
                if (SvUTF8(keysv))
@@ -1466,7 +1465,7 @@ 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(sv));
+           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV_nolen_const(sv));
        /* FALL THROUGH */
     case SVt_PVFM:
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
@@ -1525,7 +1524,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "    HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv)));
        Perl_dump_indent(aTHX_ level, file, "    CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv)));
        Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv));
-       Perl_dump_indent(aTHX_ level, file, "    GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv));
        Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", (IV)GvLINE(sv));
        Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
        Perl_dump_indent(aTHX_ level, file, "    FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv));
@@ -1619,7 +1617,7 @@ Perl_debop(pTHX_ const OP *o)
        if (cGVOPo_gv) {
            SV *sv = NEWSV(0,0);
            gv_fullname3(sv, cGVOPo_gv, Nullch);
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
            SvREFCNT_dec(sv);
        }
        else
@@ -1633,13 +1631,13 @@ Perl_debop(pTHX_ const OP *o)
        CV *cv = deb_curcv(cxstack_ix);
        SV *sv;
         if (cv) {
-            AV *padlist = CvPADLIST(cv);
-            AV *comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
+            AV * const padlist = CvPADLIST(cv);
+            AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
             sv = *av_fetch(comppad, o->op_targ, FALSE);
         } else
             sv = Nullsv;
         if (sv)
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen_const(sv));
         else
            PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
        }
@@ -1682,7 +1680,7 @@ S_debprof(pTHX_ const OP *o)
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return;
     if (!PL_profiledata)
-       Newz(000, PL_profiledata, MAXO, U32);
+       Newxz(PL_profiledata, MAXO, U32);
     ++PL_profiledata[o->op_type];
 }