This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Integrate:
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index 54d50e6..724baf8 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -9,8 +9,10 @@
  */
 
 /*
- * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
- * it has not been hard for me to read your mind and memory.'"
+ *  'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
+ *   it has not been hard for me to read your mind and memory.'
+ *
+ *     [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"]
  */
 
 /* This file contains utility routines to dump the contents of SV and OP
@@ -110,7 +112,7 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
-           const GV * const gv = (GV*)HeVAL(entry);
+           const GV * const gv = (const GV *)HeVAL(entry);
            if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
                continue;
            if (GvCVu(gv))
@@ -229,7 +231,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
 
     if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
            /* This won't alter the UTF-8 flag */
-           sv_setpvn(dsv, "", 0);
+           sv_setpvs(dsv, "");
     }
     
     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
@@ -342,29 +344,29 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
    
     if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
            /* This won't alter the UTF-8 flag */
-           sv_setpvn(dsv, "", 0);
+           sv_setpvs(dsv, "");
     }
 
     if ( dq == '"' )
-        sv_catpvn(dsv, "\"", 1);
+        sv_catpvs(dsv, "\"");
     else if ( flags & PERL_PV_PRETTY_LTGT )
-        sv_catpvn(dsv, "<", 1);
+        sv_catpvs(dsv, "<");
         
     if ( start_color != NULL ) 
-        Perl_sv_catpv( aTHX_ dsv, start_color);
+        sv_catpv(dsv, start_color);
     
     pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );    
     
     if ( end_color != NULL ) 
-        Perl_sv_catpv( aTHX_ dsv, end_color);
+        sv_catpv(dsv, end_color);
 
     if ( dq == '"' ) 
-       sv_catpvn( dsv, "\"", 1 );
+       sv_catpvs( dsv, "\"");
     else if ( flags & PERL_PV_PRETTY_LTGT )
-        sv_catpvn( dsv, ">", 1);         
+        sv_catpvs(dsv, ">");         
     
     if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
-           sv_catpvn( dsv, "...", 3 );
+           sv_catpvs(dsv, "...");
  
     return SvPVX(dsv);
 }
@@ -391,7 +393,7 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
 
     pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
     if (len > cur && pv[cur] == '\0')
-            sv_catpvn( dsv, "\\0", 2 );
+            sv_catpvs( dsv, "\\0");
     return SvPVX(dsv);
 }
 
@@ -403,13 +405,13 @@ Perl_sv_peek(pTHX_ SV *sv)
     int unref = 0;
     U32 type;
 
-    sv_setpvn(t, "", 0);
+    sv_setpvs(t, "");
   retry:
     if (!sv) {
        sv_catpv(t, "VOID");
        goto finish;
     }
-    else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
+    else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') {
        sv_catpv(t, "WILD");
        goto finish;
     }
@@ -480,7 +482,7 @@ Perl_sv_peek(pTHX_ SV *sv)
            sv_catpv(t, "...");
            goto finish;
        }
-       sv = (SV*)SvRV(sv);
+       sv = SvRV(sv);
        goto retry;
     }
     type = SvTYPE(sv);
@@ -530,6 +532,8 @@ Perl_sv_peek(pTHX_ SV *sv)
   finish:
     while (unref--)
        sv_catpv(t, ")");
+    if (PL_tainting && SvTAINTED(sv))
+       sv_catpv(t, " [tainted]");
     return SvPV_nolen(t);
 }
 
@@ -988,13 +992,13 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 
 #ifdef PERL_MAD
     if (PL_madskills && o->op_madprop) {
-       SV * const tmpsv = newSVpvn("", 0);
+       SV * const tmpsv = newSVpvs("");
        MADPROP* mp = o->op_madprop;
        Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
        level++;
        while (mp) {
            const char tmp = mp->mad_key;
-           sv_setpvn(tmpsv,"'",1);
+           sv_setpvs(tmpsv,"'");
            if (tmp)
                sv_catpvn(tmpsv, &tmp, 1);
            sv_catpv(tmpsv, "'=");
@@ -1046,7 +1050,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                   UTF-8 cleanliness of the dump file handle?  */
                SvUTF8_on(tmpsv);
 #endif
-               gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, NULL);
+               gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
                Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
                                 SvPV_nolen_const(tmpsv));
                LEAVE;
@@ -1328,7 +1332,8 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
             }
            else if (mg->mg_len == HEf_SVKEY) {
                PerlIO_puts(file, " => HEf_SVKEY\n");
-               do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
+               do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1,
+                          maxnest, dumpops, pvlim); /* MG is already +1 */
                continue;
            }
            else
@@ -1656,15 +1661,15 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        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", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
-       sv_setpvn(d, "", 0);
+       sv_setpvs(d, "");
        if (AvREAL(sv)) sv_catpv(d, ",REAL");
        if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n",
                         SvCUR(d) ? SvPVX_const(d) + 1 : "");
-       if (nest < maxnest && av_len((AV*)sv) >= 0) {
+       if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) {
            int count;
-           for (count = 0; count <=  av_len((AV*)sv) && count < maxnest; count++) {
-               SV** const elt = av_fetch((AV*)sv,count,0);
+           for (count = 0; count <=  av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
+               SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
 
                Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
                if (elt)
@@ -1745,12 +1750,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", hvname);
        }
        if (SvOOK(sv)) {
-           const AV * const backrefs
+           AV * const backrefs
                = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv));
            if (backrefs) {
                Perl_dump_indent(aTHX_ level, file, "  BACKREFS = 0x%"UVxf"\n",
                                 PTR2UV(backrefs));
-               do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest,
+               do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest,
                           dumpops, pvlim);
            }
        }
@@ -1840,7 +1845,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                         : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
        }
        if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))
-           do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim);
+           do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim);
        break;
     case SVt_PVGV:
     case SVt_PVLV:
@@ -1895,8 +1900,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        else {
            Perl_dump_indent(aTHX_ level, file, "  TOP_GV = 0x%"UVxf"\n",
                             PTR2UV(IoTOP_GV(sv)));
-           do_sv_dump (level+1, file, (SV *) IoTOP_GV(sv), nest+1, maxnest,
-                       dumpops, pvlim);
+           do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1,
+                       maxnest, dumpops, pvlim);
        }
        /* Source filters hide things that are not GVs in these three, so let's
           be careful out there.  */
@@ -1907,8 +1912,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        else {
            Perl_dump_indent(aTHX_ level, file, "  FMT_GV = 0x%"UVxf"\n",
                             PTR2UV(IoFMT_GV(sv)));
-           do_sv_dump (level+1, file, (SV *) IoFMT_GV(sv), nest+1, maxnest,
-                       dumpops, pvlim);
+           do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1,
+                       maxnest, dumpops, pvlim);
        }
         if (IoBOTTOM_NAME(sv))
             Perl_dump_indent(aTHX_ level, file, "  BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
@@ -1917,8 +1922,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        else {
            Perl_dump_indent(aTHX_ level, file, "  BOTTOM_GV = 0x%"UVxf"\n",
                             PTR2UV(IoBOTTOM_GV(sv)));
-           do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
-                       dumpops, pvlim);
+           do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1,
+                       maxnest, dumpops, pvlim);
        }
        if (isPRINT(IoTYPE(sv)))
             Perl_dump_indent(aTHX_ level, file, "  TYPE = '%c'\n", IoTYPE(sv));
@@ -2030,7 +2035,7 @@ Perl_debop(pTHX_ const OP *o)
        SV *sv;
         if (cv) {
            AV * const padlist = CvPADLIST(cv);
-            AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
+            AV * const comppad = MUTABLE_AV(*av_fetch(padlist, 0, FALSE));
             sv = *av_fetch(comppad, o->op_targ, FALSE);
         } else
             sv = NULL;
@@ -2167,7 +2172,7 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash)
        return;
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
-           GV *gv = (GV*)HeVAL(entry);
+           GV *gv = MUTABLE_GV(HeVAL(entry));
            HV *hv;
            if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
                continue;
@@ -2240,7 +2245,7 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
 
     PERL_ARGS_ASSERT_SV_CATXMLPVN;
 
-    sv_catpvn(dsv,"",0);
+    sv_catpvs(dsv,"");
     dsvcur = SvCUR(dsv);       /* in case we have to restart */
 
   retry:
@@ -2366,13 +2371,13 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     PERL_ARGS_ASSERT_SV_XMLPEEK;
 
     sv_utf8_upgrade(t);
-    sv_setpvn(t, "", 0);
+    sv_setpvs(t, "");
     /* retry: */
     if (!sv) {
        sv_catpv(t, "VOID=\"\"");
        goto finish;
     }
-    else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
+    else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') {
        sv_catpv(t, "WILD=\"\"");
        goto finish;
     }
@@ -2536,7 +2541,7 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     if (PM_GETRE(pm)) {
        REGEXP *const r = PM_GETRE(pm);
        SV * const tmpsv = newSVpvn_utf8("", 0, TRUE);
-       sv_catxmlsv(tmpsv, (SV*)r);
+       sv_catxmlsv(tmpsv, MUTABLE_SV(r));
        Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
             SvPVX(tmpsv));
        SvREFCNT_dec(tmpsv);
@@ -2616,7 +2621,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
     PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
 #endif
     if (o->op_flags) {
-       SV * const tmpsv = newSVpvn("", 0);
+       SV * const tmpsv = newSVpvs("");
        switch (o->op_flags & OPf_WANT) {
        case OPf_WANT_VOID:
            sv_catpv(tmpsv, ",VOID");
@@ -2647,7 +2652,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
        SvREFCNT_dec(tmpsv);
     }
     if (o->op_private) {
-       SV * const tmpsv = newSVpvn("", 0);
+       SV * const tmpsv = newSVpvs("");
        if (PL_opargs[o->op_type] & OA_TARGLEX) {
            if (o->op_private & OPpTARGET_MY)
                sv_catpv(tmpsv, ",TARGET_MY");
@@ -2831,7 +2836,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
            ENTER;
            SAVEFREESV(tmpsv1);
            SAVEFREESV(tmpsv2);
-           gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, NULL);
+           gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL);
            s = SvPV(tmpsv1,len);
            sv_catxmlpvn(tmpsv2, s, len, 1);
            S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
@@ -2924,7 +2929,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
        level++;
        while (mp) {
            char tmp = mp->mad_key;
-           sv_setpvn(tmpsv,"\"",1);
+           sv_setpvs(tmpsv,"\"");
            if (tmp)
                sv_catxmlpvn(tmpsv, &tmp, 1, 0);
            if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
@@ -2945,7 +2950,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
                break;
            case MAD_SV:
                sv_catpv(tmpsv, " val=\"");
-               sv_catxmlsv(tmpsv, (SV*)mp->mad_val);
+               sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val));
                sv_catpv(tmpsv, "\"");
                Perl_xmldump_indent(aTHX_ level, file, "<mad_sv key=%s/>\n", SvPVX(tmpsv));
                break;
Unnamed repository; edit this file 'description' to name the repository.