Re: Fix loads of warnings from the last escaping patch...

Message-ID: <9b18b3110607161059j276ac869p450aa178150044ae@mail.gmail.com>

p4raw-id: //depot/perl@28589

7 files changed, 91 insertions, 41 deletions

diff --git a/dump.c b/dump.c
index f9cd28dd7d..03bdab3bac 100644
--- a/dump.c
+++ b/dump.c
@@ -121,7 +121,7 @@ Perl_dump_eval(pTHX)
 
 
 /*
-=for apidoc Apd|char*|pv_escape|NN SV *dsv|NN const U8 const *str\
+=for apidoc Apd|char*|pv_escape|NN SV *dsv|NN const char const *str\
                |const STRLEN count|const STRLEN max
                |STRLEN const *escaped, const U32 flags
 
@@ -158,28 +158,29 @@ Returns a pointer to the escaped text as held by dsv.
 =cut
 */
 #define PV_ESCAPE_OCTBUFSIZE 32
+
 char *
-Perl_pv_escape( pTHX_ SV *dsv, U8 const * const str, 
+Perl_pv_escape( pTHX_ SV *dsv, char const * const str, 
                 const STRLEN count, const STRLEN max, 
                 STRLEN * const escaped, const U32 flags ) 
 {
-    U8 dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : '\\';
-    U8 octbuf[PV_ESCAPE_OCTBUFSIZE] = "\\123456789ABCDF";
+    char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : '\\';
+    char octbuf[PV_ESCAPE_OCTBUFSIZE] = "\\123456789ABCDF";
     STRLEN wrote = 0;    /* chars written so far */
     STRLEN chsize = 0;   /* size of data to be written */
     STRLEN readsize = 1; /* size of data just read */
     bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this unicode */
-    const U8 *pv  = str;
-    const U8 *end = pv + count; /* end of string */
+    const char *pv  = str;
+    const char *end = pv + count; /* end of string */
 
     if (!flags & PERL_PV_ESCAPE_NOCLEAR) 
 	    sv_setpvn(dsv, "", 0);
     
-    if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string(pv, count))
+    if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
         isuni = 1;
     
     for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) {
-        const UV u= (isuni) ? utf8_to_uvchr(pv, &readsize) : *pv;            
+        const UV u= (isuni) ? utf8_to_uvchr((U8*)pv, &readsize) : (U8)*pv;            
         const U8 c = (U8)u & 0xFF;
         
         if ( ( u > 255 ) || (flags & PERL_PV_ESCAPE_ALL)) {
@@ -208,7 +209,7 @@ Perl_pv_escape( pTHX_ SV *dsv, U8 const * const str,
                             chsize = 1;
 				break;
 		default:
-                        if ( (pv < end) && isDIGIT(*(pv+readsize)) )
+                        if ( (pv < end) && isDIGIT((U8)*(pv+readsize)) )
                             chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, 
                                                   "\\%03o", c);
 			    else
@@ -236,9 +237,9 @@ Perl_pv_escape( pTHX_ SV *dsv, U8 const * const str,
     return SvPVX(dsv);
 }
 /*
-=for apidoc Apd|char *|pv_pretty|NN SV *dsv|NN const U8 const *str\
+=for apidoc Apd|char *|pv_pretty|NN SV *dsv|NN const char const *str\
            |const STRLEN count|const STRLEN max\
-           |const U8 const *start_color| const U8 const *end_color\
+           |const char const *start_color| const char const *end_color\
            |const U32 flags
 
 Converts a string into something presentable, handling escaping via
@@ -264,8 +265,8 @@ Returns a pointer to the prettified text as held by dsv.
 */
 
 char *
-Perl_pv_pretty( pTHX_ SV *dsv, U8 const * const str, const STRLEN count, 
-  const STRLEN max, U8 const * const start_color, U8 const * const end_color, 
+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 ) 
 {
     U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '\\';
@@ -318,7 +319,7 @@ Note that the final string may be up to 7 chars longer than pvlim.
 char *
 Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 {
-    pv_pretty( dsv, pv, cur, pvlim, 0, 0, PERL_PV_PRETTY_DUMP);
+    pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
     if (len > cur && pv[cur] == '\0')
             sv_catpvn( dsv, "\\0", 2 );
     return SvPVX(dsv);
diff --git a/embed.fnc b/embed.fnc
index f57cf92e31..d69d87e555 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -982,14 +982,14 @@ Apdbm	|void	|sv_usepvn_mg	|NN SV *sv|NULLOK char *ptr|STRLEN len
 ApR	|MGVTBL*|get_vtbl	|int vtbl_id
 Apd	|char*	|pv_display	|NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \
 				|STRLEN pvlim
-Apd	|char*	|pv_escape	|NN SV *dsv|NN U8 const * const str\
+Apd	|char*	|pv_escape	|NN SV *dsv|NN char const * const str\
                                 |const STRLEN count|const STRLEN max\
                                 |NULLOK STRLEN * const escaped\
                                 |const U32 flags				
-Apd     |char*  |pv_pretty      |NN SV *dsv|NN U8 const * const str\
+Apd     |char*  |pv_pretty      |NN SV *dsv|NN char const * const str\
                                 |const STRLEN count|const STRLEN max\
-                                |NULLOK U8 const * const start_color\
-                                |NULLOK U8 const * const end_color\
+                                |NULLOK char const * const start_color\
+                                |NULLOK char const * const end_color\
                                 |const U32 flags				
 Afp	|void	|dump_indent	|I32 level|NN PerlIO *file|NN const char* pat|...
 Ap	|void	|dump_vindent	|I32 level|NN PerlIO *file|NN const char* pat \
diff --git a/ext/re/re.pm b/ext/re/re.pm
index 51545acbcd..a9bff82bb6 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -235,9 +235,10 @@ my %flags = (
     OFFSETS_DEBUG   => 0x020000,
     STATE           => 0x040000,
 );
-$flags{ALL} = $flags{COMPILE} | $flags{EXECUTE};
+$flags{ALL} = $flags{COMPILE} | $flags{EXECUTE} | $flags{STATE};
 $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
 $flags{More} = $flags{MORE} = $flags{ALL} | $flags{TRIE_MORE};
+$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
 
 my $installed = 0;
 
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index d832d0a3e5..c341126d93 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -781,27 +781,75 @@ Found in file dump.c
 =item pv_escape
 X<pv_escape>
 
+               |const STRLEN count|const STRLEN max
+               |STRLEN const *escaped, const U32 flags
+
 Escapes at most the first "count" chars of pv and puts the results into
-buf such that the size of the escaped string will not exceed "max" chars
+dsv such that the size of the escaped string will not exceed "max" chars
 and will not contain any incomplete escape sequences.
 
-If flags contains PERL_PV_ESCAPE_QUOTE then the string will have quotes
-placed around it; moreover, if the number of chars converted was less than
-"count" then a trailing elipses (...) will be added after the closing
-quote.
-
-If PERL_PV_ESCAPE_QUOTE is not set, but PERL_PV_ESCAPE_PADR is, then the
-returned string will be right padded with spaces such that it is max chars
-long.
+If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string
+will also be escaped.
 
 Normally the SV will be cleared before the escaped string is prepared,
-but when PERL_PV_ESCAPE_CAT is set this will not occur.
+but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
+
+If PERL_PV_ESCAPE_UNI is set then the input string is treated as unicode,
+if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
+using C<is_utf8_string()> to determine if it is unicode.
+
+If PERL_PV_ESCAPE_ALL is set then all input chars will be output
+using C<\x01F1> style escapes, otherwise only chars above 255 will be
+escaped using this style, other non printable chars will use octal or
+common escaped patterns like C<\n>. If PERL_PV_ESCAPE_NOBACKSLASH
+then all chars below 255 will be treated as printable and 
+will be output as literals.
+
+If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the
+string will be escaped, regardles of max. If the string is utf8 and 
+the chars value is >255 then it will be returned as a plain hex 
+sequence. Thus the output will either be a single char, 
+an octal escape sequence, a special escape like C<\n> or a 3 or 
+more digit hex value. 
+
+Returns a pointer to the escaped text as held by dsv.
 
-Returns a pointer to the string contained by SV.
+NOTE: the perl_ form of this function is deprecated.
+
+	char*	pv_escape(SV *dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags)
+
+=for hackers
+Found in file dump.c
 
+=item pv_pretty
+X<pv_pretty>
+
+           |const STRLEN count|const STRLEN max\
+           |const char const *start_color| const char const *end_color\
+           |const U32 flags
+
+Converts a string into something presentable, handling escaping via
+pv_escape() and supporting quoting and elipses. 
+
+If the PERL_PV_PRETTY_QUOTE flag is set then the result will be 
+double quoted with any double quotes in the string escaped. Otherwise
+if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in
+angle brackets. 
+           
+If the PERL_PV_PRETTY_ELIPSES flag is set and not all characters in
+string were output then an elipses C<...> will be appended to the 
+string. Note that this happens AFTER it has been quoted.
+           
+If start_color is non-null then it will be inserted after the opening
+quote (if there is one) but before the escaped text. If end_color
+is non-null then it will be inserted after the escaped text but before
+any quotes or elipses.
+
+Returns a pointer to the prettified text as held by dsv.
+           
 NOTE: the perl_ form of this function is deprecated.
 
-	char*	pv_escape(SV *dsv, const char *pv, const STRLEN count, const STRLEN max, const U32 flags)
+	char*	pv_pretty(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)
 
 =for hackers
 Found in file dump.c
diff --git a/proto.h b/proto.h
index 7fa377ba8b..8f9bfa4271 100644
--- a/proto.h
+++ b/proto.h
@@ -2674,11 +2674,11 @@ PERL_CALLCONV char*	Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, S
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV char*	Perl_pv_escape(pTHX_ SV *dsv, U8 const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags)
+PERL_CALLCONV char*	Perl_pv_escape(pTHX_ SV *dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV char*	Perl_pv_pretty(pTHX_ SV *dsv, U8 const * const str, const STRLEN count, const STRLEN max, U8 const * const start_color, U8 const * const end_color, const U32 flags)
+PERL_CALLCONV char*	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)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
 
diff --git a/regcomp.c b/regcomp.c
index 08424485b2..f4821c0481 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -867,7 +867,7 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth)
         if ( tmp ) {
             PerlIO_printf( Perl_debug_log, "%*s", 
                 colwidth,
-                pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
+                pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
 	                    PL_colors[0], PL_colors[1],
 	                    (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
 	                    PERL_PV_ESCAPE_FIRSTCHAR 
@@ -960,7 +960,7 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc
 	    if ( tmp ) {
                 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
                     colwidth,
-                    pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
+                    pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
 	                    PL_colors[0], PL_colors[1],
 	                    (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
 	                    PERL_PV_ESCAPE_FIRSTCHAR 
@@ -1002,7 +1002,7 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_allo
         if ( tmp ) {
             PerlIO_printf( Perl_debug_log, "%*s", 
                 colwidth,
-                pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
+                pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
 	                    PL_colors[0], PL_colors[1],
 	                    (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
 	                    PERL_PV_ESCAPE_FIRSTCHAR 
@@ -6454,7 +6454,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
 	 * we have no flag "this EXACTish node was UTF-8" 
 	 * --jhi */
 	const char * const s = 
-	    pv_pretty(dsv, (U8*)STRING(o), STR_LEN(o), 60, 
+	    pv_pretty(dsv, STRING(o), STR_LEN(o), 60, 
 	        PL_colors[0], PL_colors[1],
 	        PERL_PV_ESCAPE_UNI_DETECT |
 	        PERL_PV_PRETTY_ELIPSES    |
@@ -7029,7 +7029,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
 		if (elem_ptr) 
 		    PerlIO_printf(Perl_debug_log, "%*s%s\n",
 		       (int)(2*(l+4)), "",
-		        pv_pretty(sv, (U8*)SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60, 
+		        pv_pretty(sv, SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60, 
 	                    PL_colors[0], PL_colors[1],
 	                    (SvUTF8(*elem_ptr) ? PERL_PV_ESCAPE_UNI : 0) |
 	                    PERL_PV_PRETTY_ELIPSES    |
diff --git a/regcomp.h b/regcomp.h
index e46f6f4659..5c35f634d0 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -631,20 +631,20 @@ re.pm, especially to the documentation.
 
 #define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) \
     const char * const rpv =                          \
-        pv_pretty((dsv), (U8*)(pv), (l), (m), \
+        pv_pretty((dsv), (pv), (l), (m), \
             PL_colors[(c1)],PL_colors[(c2)], \
             ((isuni) ? PERL_PV_ESCAPE_UNI : 0) );         \
     const int rlen = SvCUR(dsv)
 
 #define RE_SV_ESCAPE(rpv,isuni,dsv,sv,m) \
     const char * const rpv =                          \
-        pv_pretty((dsv), (U8*)(SvPV_nolen_const(sv)), (SvCUR(sv)), (m), \
+        pv_pretty((dsv), (SvPV_nolen_const(sv)), (SvCUR(sv)), (m), \
             PL_colors[(c1)],PL_colors[(c2)], \
             ((isuni) ? PERL_PV_ESCAPE_UNI : 0) )
 
 #define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m)                    \
     const char * const rpv =                                       \
-        pv_pretty((dsv), (U8*)(pv), (l), (m), \
+        pv_pretty((dsv), (pv), (l), (m), \
             PL_colors[0], PL_colors[1], \
             ( PERL_PV_PRETTY_QUOTE | PERL_PV_PRETTY_ELIPSES |      \
               ((isuni) ? PERL_PV_ESCAPE_UNI : 0))                  \