extra code in pp_concat, Take 2

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

diff --git a/dump.c b/dump.c
index 9acd3c6..cc500e0 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1,7 +1,7 @@
 /*    dump.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -229,7 +229,7 @@ Perl_sv_peek(pTHX_ SV *sv)
     if (SvROK(sv)) {
        sv_catpv(t, "\\");
        if (SvCUR(t) + unref > 10) {
-           SvCUR(t) = unref + 3;
+           SvCUR_set(t, unref + 3);
            *SvEND(t) = '\0';
            sv_catpv(t, "...");
            goto finish;
@@ -334,7 +334,7 @@ Perl_sv_peek(pTHX_ SV *sv)
 }
 
 void
-Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm)
+Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
 {
     char ch;
 
@@ -402,14 +402,14 @@ Perl_pmop_dump(pTHX_ PMOP *pm)
 /* An op sequencer.  We visit the ops in the order they're to execute. */
 
 STATIC void
-sequence(pTHX_ register OP *o)
+sequence(pTHX_ register const OP *o)
 {
     SV      *op;
     char    *key;
     STRLEN   len;
     static   UV seq;
-    OP      *oldop = 0,
-            *l;
+    const OP *oldop = 0;
+    OP      *l;
 
     if (!Sequence)
        Sequence = newHV();
@@ -499,7 +499,7 @@ sequence(pTHX_ register OP *o)
 }
 
 STATIC UV
-sequence_num(pTHX_ OP *o)
+sequence_num(pTHX_ const OP *o)
 {
     SV     *op,
           **seq;
@@ -513,7 +513,7 @@ sequence_num(pTHX_ OP *o)
 }
 
 void
-Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
+Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 {
     UV      seq;
     sequence(aTHX_ o);
@@ -856,7 +856,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 }
 
 void
-Perl_op_dump(pTHX_ OP *o)
+Perl_op_dump(pTHX_ const OP *o)
 {
     do_op_dump(0, Perl_debug_log, o);
 }
@@ -932,7 +932,7 @@ static struct { const char type; const char *name; } magic_names[] = {
 };
 
 void
-Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
+Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
     for (; mg; mg = mg->mg_moremagic) {
        Perl_dump_indent(aTHX_ level, file,
@@ -1050,7 +1050,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
 }
 
 void
-Perl_magic_dump(pTHX_ MAGIC *mg)
+Perl_magic_dump(pTHX_ const MAGIC *mg)
 {
     do_magic_dump(0, Perl_debug_log, mg, 0, 0, 0, 0);
 }
@@ -1136,7 +1136,8 @@ 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)    sv_catpv(d, "SCREAM,");
+    if (flags & SVp_SCREAM && type != SVt_PVHV)
+                               sv_catpv(d, "SCREAM,");
 
     switch (type) {
     case SVt_PVCV:
@@ -1159,6 +1160,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (HvLAZYDEL(sv))      sv_catpv(d, "LAZYDEL,");
        if (HvHASKFLAGS(sv))    sv_catpv(d, "HASKFLAGS,");
        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,");
@@ -1198,8 +1200,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if ((type != SVt_PVHV) && SvUTF8(sv))
         sv_catpv(d, "UTF8");
 
-    if (*(SvEND(d) - 1) == ',')
-       SvPVX(d)[--SvCUR(d)] = '\0';
+    if (*(SvEND(d) - 1) == ',') {
+        SvCUR_set(d, SvCUR(d) - 1);
+       SvPVX(d)[SvCUR(d)] = '\0';
+    }
     sv_catpv(d, ")");
     s = SvPVX(d);
 
@@ -1586,9 +1590,8 @@ Perl_runops_debug(pTHX)
 }
 
 I32
-Perl_debop(pTHX_ OP *o)
+Perl_debop(pTHX_ const OP *o)
 {
-    AV *padlist, *comppad;
     CV *cv;
     SV *sv;
 
@@ -1617,8 +1620,8 @@ Perl_debop(pTHX_ OP *o)
        /* print the lexical's name */
         cv = deb_curcv(cxstack_ix);
         if (cv) {
-            padlist = CvPADLIST(cv);
-            comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
+            AV *padlist = CvPADLIST(cv);
+            AV *comppad = (AV*)(*av_fetch(padlist, 0, FALSE));
             sv = *av_fetch(comppad, o->op_targ, FALSE);
         } else
             sv = Nullsv;