Mark is_ascii_string() as requiring looking at return value

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index 16ac581..2654402 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -96,7 +96,10 @@ S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start,
 
 Escapes at most the first "count" chars of pv and puts the results into
 dsv such that the size of the escaped string will not exceed "max" chars
 
 Escapes at most the first "count" chars of pv and puts the results into
 dsv such that the size of the escaped string will not exceed "max" chars

-and will not contain any incomplete escape sequences.
+and will not contain any incomplete escape sequences.  The number of bytes
+escaped will be returned in the STRLEN *escaped parameter if it is not null.
+When the dsv parameter is null no escaping actually occurs, but the number
+of bytes that would be escaped were it not null will be calculated.

 
 If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
 will also be escaped.
 
 If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
 will also be escaped.


@@ -151,7 +154,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
 
     PERL_ARGS_ASSERT_PV_ESCAPE;
 
 
     PERL_ARGS_ASSERT_PV_ESCAPE;
 

-    if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
+    if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) {

            /* This won't alter the UTF-8 flag */
            sv_setpvs(dsv, "");
     }
            /* This won't alter the UTF-8 flag */
            sv_setpvs(dsv, "");
     }


@@ -221,7 +224,8 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
        if ( max && (wrote + chsize > max) ) {
            break;
         } else if (chsize > 1) {
        if ( max && (wrote + chsize > max) ) {
            break;
         } else if (chsize > 1) {

-            sv_catpvn(dsv, octbuf, chsize);
+            if (dsv)
+                sv_catpvn(dsv, octbuf, chsize);

             wrote += chsize;
        } else {
            /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
             wrote += chsize;
        } else {
            /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes


@@ -230,7 +234,8 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
               Or add a new API call sv_catpvc(). Think about that name, and
               how to keep it clear that it's unlike the s of catpvs, which is
               really an array of octets, not a string.  */
               Or add a new API call sv_catpvc(). Think about that name, and
               how to keep it clear that it's unlike the s of catpvs, which is
               really an array of octets, not a string.  */

-            Perl_sv_catpvf( aTHX_ dsv, "%c", c);
+            if (dsv)
+                Perl_sv_catpvf( aTHX_ dsv, "%c", c);

            wrote++;
        }
         if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) 
            wrote++;
        }
         if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) 


@@ -238,7 +243,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
     }
     if (escaped != NULL)
         *escaped= pv - str;
     }
     if (escaped != NULL)
         *escaped= pv - str;

-    return SvPVX(dsv);
+    return dsv ? SvPVX(dsv) : NULL;

 }
 /*
 =for apidoc pv_pretty
 }
 /*
 =for apidoc pv_pretty


@@ -270,36 +275,51 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
   const STRLEN max, char const * const start_color, char const * const end_color, 
   const U32 flags ) 
 {
   const STRLEN max, char const * const start_color, char const * const end_color, 
   const U32 flags ) 
 {

-    const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+    const U8 *quotes = (U8*)((flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
+                             (flags & PERL_PV_PRETTY_LTGT)  ? "<>" : NULL);

     STRLEN escaped;
     STRLEN escaped;

+    STRLEN max_adjust= 0;
+    STRLEN orig_cur;

  
     PERL_ARGS_ASSERT_PV_PRETTY;
    
     if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
  
     PERL_ARGS_ASSERT_PV_PRETTY;
    
     if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {

-           /* This won't alter the UTF-8 flag */
-           sv_setpvs(dsv, "");
+        /* This won't alter the UTF-8 flag */
+        sv_setpvs(dsv, "");

     }
     }

+    orig_cur= SvCUR(dsv);

 
 

-    if ( dq == '"' )
-        sv_catpvs(dsv, "\"");
-    else if ( flags & PERL_PV_PRETTY_LTGT )
-        sv_catpvs(dsv, "<");
+    if ( quotes )
+        Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[0]);

         
     if ( start_color != NULL ) 
         sv_catpv(dsv, start_color);
         
     if ( start_color != NULL ) 
         sv_catpv(dsv, start_color);

-    
-    pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );    
-    
+
+    if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
+        if (quotes)
+            max_adjust += 2;
+        assert(max > max_adjust);
+        pv_escape( NULL, str, count, max - max_adjust, &escaped, flags );
+        if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
+            max_adjust += 3;
+        assert(max > max_adjust);
+    }
+
+    pv_escape( dsv, str, count, max - max_adjust, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
+

     if ( end_color != NULL ) 
         sv_catpv(dsv, end_color);
 
     if ( end_color != NULL ) 
         sv_catpv(dsv, end_color);
 

-    if ( dq == '"' ) 
-       sv_catpvs( dsv, "\"");
-    else if ( flags & PERL_PV_PRETTY_LTGT )
-        sv_catpvs(dsv, ">");         
+    if ( quotes )
+        Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[1]);

     
     if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
            sv_catpvs(dsv, "...");
     
     if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
            sv_catpvs(dsv, "...");

+
+    if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
+        while( SvCUR(dsv) - orig_cur < max )
+            sv_catpvs(dsv," ");
+    }

  
     return SvPVX(dsv);
 }
  
     return SvPVX(dsv);
 }


@@ -642,8 +662,8 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     else
        ch = '/';
     if (PM_GETRE(pm))
     else
        ch = '/';
     if (PM_GETRE(pm))

-       Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
-            ch, RX_PRECOMP(PM_GETRE(pm)), ch,
+       Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%.*s%c%s\n",
+            ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch,

             (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
     else
        Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
             (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
     else
        Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");


@@ -792,30 +812,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     if (o->op_targ) {
        if (optype == OP_NULL) {
            Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
     if (o->op_targ) {
        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 (CopLINE(cCOPo))
-                   Perl_dump_indent(aTHX_ level, file, "LINE = %"UVuf"\n",
-                                    (UV)CopLINE(cCOPo));
-        if (CopSTASHPV(cCOPo)) {
-            SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
-            HV *stash = CopSTASH(cCOPo);
-            const char * const hvname = HvNAME_get(stash);
-
-                   Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n",
-                           generic_pv_escape( tmpsv, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash)));
-       }
-     if (CopLABEL(cCOPo)) {
-          SV* tmpsv = newSVpvs_flags("", SVs_TEMP);
-          STRLEN label_len;
-          U32 label_flags;
-          const char *label = CopLABEL_len_flags(cCOPo,
-                                                 &label_len,
-                                                 &label_flags);
-                   Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",
-                           generic_pv_escape( tmpsv, label, label_len,(label_flags & SVf_UTF8)));
-      }
-
-           }

        }
        else
            Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
        }
        else
            Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);


@@ -962,9 +958,13 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #ifndef USE_ITHREADS
        /* with ITHREADS, consts are stored in the pad, and the right pad
         * may not be active here, so skip */
 #ifndef USE_ITHREADS
        /* with ITHREADS, consts are stored in the pad, and the right pad
         * may not be active here, so skip */

-       Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
+       Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o)));

 #endif
        break;
 #endif
        break;

+    case OP_NULL:
+       if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE)
+           break;
+       /* FALLTHROUGH */

     case OP_NEXTSTATE:
     case OP_DBSTATE:
        if (CopLINE(cCOPo))
     case OP_NEXTSTATE:
     case OP_DBSTATE:
        if (CopLINE(cCOPo))


@@ -989,6 +989,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                            generic_pv_escape( tmpsv, label, label_len,
                                       (label_flags & SVf_UTF8)));
    }
                            generic_pv_escape( tmpsv, label, label_len,
                                       (label_flags & SVf_UTF8)));
    }

+        Perl_dump_indent(aTHX_ level, file, "SEQ = %d\n",
+                                             cCOPo->cop_seq);

        break;
     case OP_ENTERLOOP:
        Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
        break;
     case OP_ENTERLOOP:
        Perl_dump_indent(aTHX_ level, file, "REDO ===> ");


@@ -1363,6 +1365,7 @@ const struct flag_to_name regexp_extflags_names[] = {
     {RXf_PMf_SINGLELINE,  "PMf_SINGLELINE,"},
     {RXf_PMf_FOLD,        "PMf_FOLD,"},
     {RXf_PMf_EXTENDED,    "PMf_EXTENDED,"},
     {RXf_PMf_SINGLELINE,  "PMf_SINGLELINE,"},
     {RXf_PMf_FOLD,        "PMf_FOLD,"},
     {RXf_PMf_EXTENDED,    "PMf_EXTENDED,"},

+    {RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},

     {RXf_PMf_KEEPCOPY,    "PMf_KEEPCOPY,"},
     {RXf_IS_ANCHORED,     "IS_ANCHORED,"},
     {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
     {RXf_PMf_KEEPCOPY,    "PMf_KEEPCOPY,"},
     {RXf_IS_ANCHORED,     "IS_ANCHORED,"},
     {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},


@@ -1980,10 +1983,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
        Perl_dump_indent(aTHX_ level, file, "  OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
        Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
        Perl_dump_indent(aTHX_ level, file, "  OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));

-       Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
-       if (nest < maxnest) {
-           do_dump_pad(level+1, file, CvPADLIST(sv), 0);
+       if (!CvISXSUB(sv)) {
+           Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
+           if (nest < maxnest) {
+               do_dump_pad(level+1, file, CvPADLIST(sv), 0);
+           }

        }
        }

+       else
+           Perl_dump_indent(aTHX_ level, file, "  HSCXT = 0x%p\n", CvHSCXT(sv));

        {
            const CV * const outside = CvOUTSIDE(sv);
            Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n",
        {
            const CV * const outside = CvOUTSIDE(sv);
            Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n",