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) {
{OPpCONST_SHORTCIRCUIT, ",SHORTCIRCUIT"},
{OPpCONST_STRICT, ",STRICT"},
{OPpCONST_ENTERED, ",ENTERED"},
- {OPpCONST_FOLDED, ",FOLDED"},
{OPpCONST_BARE, ",BARE"}
};
{OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
};
-const struct flag_to_name op_exit_names[] = {
- {OPpEXIT_VMSISH, ",EXIT_VMSISH"},
- {OPpHUSH_VMSISH, ",HUSH_VMSISH"}
-};
-
const struct flag_to_name op_sassign_names[] = {
{OPpASSIGN_BACKWARDS, ",BACKWARDS"},
{OPpASSIGN_CV_TO_GV, ",CV2GV"}
};
+const struct flag_to_name op_leave_names[] = {
+ {OPpREFCOUNTED, ",REFCOUNTED"},
+ {OPpLVALUE, ",LVALUE"}
+};
+
#define OP_PRIVATE_ONCE(op, flag, name) \
const struct flag_to_name CAT2(op, _names)[] = { \
{(flag), (name)} \
OP_PRIVATE_ONCE(op_exists, OPpEXISTS_SUB, ",EXISTS_SUB");
OP_PRIVATE_ONCE(op_die, OPpHUSH_VMSISH, ",HUSH_VMSISH");
OP_PRIVATE_ONCE(op_split, OPpSPLIT_IMPLIM, ",IMPLIM");
+OP_PRIVATE_ONCE(op_dbstate, OPpHUSH_VMSISH, ",HUSH_VMSISH");
struct op_private_by_op {
U16 op_type;
const struct op_private_by_op op_private_names[] = {
{OP_LEAVESUB, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
- {OP_LEAVE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
+ {OP_LEAVE, C_ARRAY_LENGTH(op_leave_names), op_leave_names },
{OP_LEAVESUBLV, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
{OP_LEAVEWRITE, C_ARRAY_LENGTH(op_leavesub_names), op_leavesub_names },
{OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
{OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
{OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
- {OP_EXIT, C_ARRAY_LENGTH(op_exit_names), op_exit_names },
{OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
{OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
{OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
{OP_SORT, C_ARRAY_LENGTH(op_sort_names), op_sort_names },
{OP_OPEN, C_ARRAY_LENGTH(op_open_names), op_open_names },
{OP_SPLIT, C_ARRAY_LENGTH(op_split_names), op_split_names },
+ {OP_DBSTATE, C_ARRAY_LENGTH(op_dbstate_names), op_dbstate_names },
+ {OP_NEXTSTATE, C_ARRAY_LENGTH(op_dbstate_names), op_dbstate_names },
{OP_BACKTICK, C_ARRAY_LENGTH(op_open_names), op_open_names }
};
if (o->op_type == OP_PADRANGE) \
Perl_sv_catpvf(aTHX_ tmpsv, ",COUNT=%"UVuf, \
(UV)(oppriv & OPpPADRANGE_COUNTMASK)); \
+ if ( (o->op_type == OP_RV2HV || o->op_type == OP_RV2AV || \
+ o->op_type == OP_PADAV || o->op_type == OP_PADHV || \
+ o->op_type == OP_ASLICE || o->op_type == OP_HSLICE) \
+ && oppriv & OPpSLICEWARNING ) \
+ sv_catpvs(tmpsv, ",SLICEWARNING"); \
if (SvCUR(tmpsv)) { \
if (xml) \
xmldump_attr1(level+1, file, "private=\"%s\"", SvPVX(tmpsv)+1); \
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",
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",
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) {