If PERL_PV_ESCAPE_ALL is set then all input chars will be output
using C<\x01F1> style escapes, otherwise if PERL_PV_ESCAPE_NONASCII is set, only
-chars above 127 will be escaped using this style; otherwise, only chars above
+non-ASCII chars will be escaped using this style; otherwise, only chars above
255 will be so escaped; other non printable chars will use octal or
common escaped patterns like C<\n>. Otherwise, if PERL_PV_ESCAPE_NOBACKSLASH
then all chars below 255 will be treated as printable and
if ( ( u > 255 )
|| (flags & PERL_PV_ESCAPE_ALL)
- || (( u > 127 ) && (flags & PERL_PV_ESCAPE_NONASCII)))
+ || (( ! isASCII(u) ) && (flags & PERL_PV_ESCAPE_NONASCII)))
{
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
sv_catpvn(dsv, octbuf, chsize);
wrote += chsize;
} else {
- /* If PERL_PV_ESCAPE_NOBACKSLASH is set then bytes in the range
- 128-255 can be appended raw to the dsv. If dsv happens to be
+ /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes
+ can be appended raw to the dsv. If dsv happens to be
UTF-8 then we need catpvf to upgrade them for us.
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 octets, not a string. */
+ really an array of octets, not a string. */
Perl_sv_catpvf( aTHX_ dsv, "%c", c);
wrote++;
}
}
else if (DEBUG_R_TEST_) {
int is_tmp = 0;
- I32 ix;
+ SSize_t ix;
/* is this SV on the tmps stack? */
for (ix=PL_tmps_ix; ix>=0; ix--) {
if (PL_tmps_stack[ix] == sv) {
Perl_dump_indent(aTHX_ level, file, " DUP\n");
if (mg->mg_flags & MGf_LOCAL)
Perl_dump_indent(aTHX_ level, file, " LOCAL\n");
+ if (mg->mg_type == PERL_MAGIC_regex_global &&
+ mg->mg_flags & MGf_BYTES)
+ Perl_dump_indent(aTHX_ level, file, " BYTES\n");
}
if (mg->mg_obj) {
Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
if (SvWEAKREF(sv)) sv_catpv(d, "WEAKREF,");
}
append_flags(d, flags, second_sv_flags_names);
- if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
+ if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)
+ && type != SVt_PVAV) {
if (SvPCS_IMPORTED(sv))
sv_catpv(d, "PCS_IMPORTED,");
else
if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
goto evaled_or_uv;
case SVt_PVAV:
+ if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
break;
}
/* SVphv_SHAREKEYS is also 0x20000000 */
pv_display(d, ptr - delta, delta, 0,
pvlim));
}
- PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
- re ? 0 : SvLEN(sv),
- pvlim));
- if (SvUTF8(sv)) /* the 6? \x{....} */
- PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
- PerlIO_printf(file, "\n");
+ if (type == SVt_INVLIST) {
+ PerlIO_printf(file, "\n");
+ /* 4 blanks indents 2 beyond the PV, etc */
+ _invlist_dump(file, level, " ", sv);
+ }
+ else {
+ PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
+ re ? 0 : SvLEN(sv),
+ pvlim));
+ if (SvUTF8(sv)) /* the 6? \x{....} */
+ PerlIO_printf(file, " [UTF8 \"%s\"]",
+ sv_uni_display(d, sv, 6 * SvCUR(sv),
+ UNI_DISPLAY_QQ));
+ PerlIO_printf(file, "\n");
+ }
Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
if (!re)
Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n",
HV * const ost = SvOURSTASH(sv);
if (ost)
do_hv_dump(level, file, " OURSTASH", ost);
+ } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
+ Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
+ (UV)PadnamelistMAXNAMED(sv));
} else {
if (SvMAGIC(sv))
do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
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", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
+ /* arylen is stored in magic, and padnamelists use SvMAGIC for
+ something else. */
+ if (!AvPAD_NAMELIST(sv))
+ Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
+ SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 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(MUTABLE_AV(sv)) >= 0) {
- int count;
+ SSize_t count;
for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) {
SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
PTR2UV(r->engine));
Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%"UVxf"\n",
PTR2UV(r->mother_re));
+ if (nest < maxnest && r->mother_re)
+ do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1,
+ maxnest, dumpops, pvlim);
Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%"UVxf"\n",
PTR2UV(r->paren_names));
Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%"UVxf"\n",
else
c = (*pv & 255);
- switch (c) {
- case 0x00:
- case 0x01:
- case 0x02:
- case 0x03:
- case 0x04:
- case 0x05:
- case 0x06:
- case 0x07:
- case 0x08:
- case 0x0b:
- case 0x0c:
- case 0x0e:
- case 0x0f:
- case 0x10:
- case 0x11:
- case 0x12:
- case 0x13:
- case 0x14:
- case 0x15:
- case 0x16:
- case 0x17:
- case 0x18:
- case 0x19:
- case 0x1a:
- case 0x1b:
- case 0x1c:
- case 0x1d:
- case 0x1e:
- case 0x1f:
- case 0x7f:
- case 0x80:
- case 0x81:
- case 0x82:
- case 0x83:
- case 0x84:
- case 0x86:
- case 0x87:
- case 0x88:
- case 0x89:
- case 0x90:
- case 0x91:
- case 0x92:
- case 0x93:
- case 0x94:
- case 0x95:
- case 0x96:
- case 0x97:
- case 0x98:
- case 0x99:
- case 0x9a:
- case 0x9b:
- case 0x9c:
- case 0x9d:
- case 0x9e:
- case 0x9f:
+ if (isCNTRL_L1(c)
+ && c != '\t'
+ && c != '\n'
+ && c != '\r'
+ && c != LATIN1_TO_NATIVE(0x85))
+ {
Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
- break;
+ }
+ else switch (c) {
case '<':
sv_catpvs(dsv, "<");
break;
break;
default:
if (c < 0xD800) {
- if (c < 32 || c > 127) {
+ if (! isPRINT(c)) {
Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
}
else {
}
else if (DEBUG_R_TEST_) {
int is_tmp = 0;
- I32 ix;
+ SSize_t ix;
/* is this SV on the tmps stack? */
for (ix=PL_tmps_ix; ix>=0; ix--) {
if (PL_tmps_stack[ix] == sv) {
https://perl5.git.perl.org / perl5.git / blobdiff