This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add Perl_malloc_good_size to malloc.c. (A routine that rounds up the
[perl5.git]
/
dump.c
diff --git
a/dump.c
b/dump.c
index
212f720
..
7ad09b1
100644
(file)
--- a/
dump.c
+++ b/
dump.c
@@
-32,11
+32,11
@@
static const char* const svtypenames[SVt_LAST] = {
"BIND",
"IV",
"NV",
"BIND",
"IV",
"NV",
- "RV",
"PV",
"PVIV",
"PVNV",
"PVMG",
"PV",
"PVIV",
"PVNV",
"PVMG",
+ "REGEXP",
"PVGV",
"PVLV",
"PVAV",
"PVGV",
"PVLV",
"PVAV",
@@
-52,11
+52,11
@@
static const char* const svshorttypenames[SVt_LAST] = {
"BIND",
"IV",
"NV",
"BIND",
"IV",
"NV",
- "RV",
"PV",
"PVIV",
"PVNV",
"PVMG",
"PV",
"PVIV",
"PVNV",
"PVMG",
+ "REGEXP",
"GV",
"PVLV",
"AV",
"GV",
"PVLV",
"AV",
@@
-72,6
+72,7
@@
void
Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
+ PERL_ARGS_ASSERT_DUMP_INDENT;
va_start(args, pat);
dump_vindent(level, file, pat, &args);
va_end(args);
va_start(args, pat);
dump_vindent(level, file, pat, &args);
va_end(args);
@@
-81,6
+82,7
@@
void
Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
dVAR;
Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
dVAR;
+ PERL_ARGS_ASSERT_DUMP_VINDENT;
PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
}
PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
}
@@
-101,6
+103,8
@@
Perl_dump_packsubs(pTHX_ const HV *stash)
dVAR;
I32 i;
dVAR;
I32 i;
+ PERL_ARGS_ASSERT_DUMP_PACKSUBS;
+
if (!HvARRAY(stash))
return;
for (i = 0; i <= (I32) HvMAX(stash); i++) {
if (!HvARRAY(stash))
return;
for (i = 0; i <= (I32) HvMAX(stash); i++) {
@@
-127,6
+131,8
@@
Perl_dump_sub(pTHX_ const GV *gv)
{
SV * const sv = sv_newmortal();
{
SV * const sv = sv_newmortal();
+ PERL_ARGS_ASSERT_DUMP_SUB;
+
gv_fullname3(sv, gv, NULL);
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
if (CvISXSUB(GvCV(gv)))
gv_fullname3(sv, gv, NULL);
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
if (CvISXSUB(GvCV(gv)))
@@
-144,6
+150,8
@@
Perl_dump_form(pTHX_ const GV *gv)
{
SV * const sv = sv_newmortal();
{
SV * const sv = sv_newmortal();
+ PERL_ARGS_ASSERT_DUMP_FORM;
+
gv_fullname3(sv, gv, NULL);
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
if (CvROOT(GvFORM(gv)))
gv_fullname3(sv, gv, NULL);
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv));
if (CvROOT(GvFORM(gv)))
@@
-175,9
+183,9
@@
will also be escaped.
Normally the SV will be cleared before the escaped string is prepared,
but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur.
Normally the SV will be cleared before the escaped string is prepared,
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
u
nicode,
+If PERL_PV_ESCAPE_UNI is set then the input string is treated as
U
nicode,
if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned
-using C<is_utf8_string()> to determine if it is
u
nicode.
+using C<is_utf8_string()> to determine if it is
U
nicode.
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
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
@@
-214,13
+222,17
@@
Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
STRLEN wrote = 0; /* chars written so far */
STRLEN chsize = 0; /* size of data to be written */
STRLEN readsize = 1; /* size of data just read */
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
u
nicode */
+ bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this
U
nicode */
const char *pv = str;
const char * const end = pv + count; /* end of string */
octbuf[0] = esc;
const char *pv = str;
const char * const end = pv + count; /* end of string */
octbuf[0] = esc;
- if (!flags & PERL_PV_ESCAPE_NOCLEAR)
+ PERL_ARGS_ASSERT_PV_ESCAPE;
+
+ if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
+ /* This won't alter the UTF-8 flag */
sv_setpvn(dsv, "", 0);
sv_setpvn(dsv, "", 0);
+ }
if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
isuni = 1;
if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
isuni = 1;
@@
-279,6
+291,12
@@
Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
sv_catpvn(dsv, octbuf, chsize);
wrote += chsize;
} else {
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
+ 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. */
Perl_sv_catpvf( aTHX_ dsv, "%c", c);
wrote++;
}
Perl_sv_catpvf( aTHX_ dsv, "%c", c);
wrote++;
}
@@
-296,21
+314,21
@@
Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
|const U32 flags
Converts a string into something presentable, handling escaping via
|const U32 flags
Converts a string into something presentable, handling escaping via
-pv_escape() and supporting quoting and el
ipses.
+pv_escape() and supporting quoting and el
lipses.
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_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 el
ipses C<...> will be appended to the
+If the PERL_PV_PRETTY_EL
L
IPSES flag is set and not all characters in
+string were output then an el
lipsis 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
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.
+any quotes or el
l
ipses.
Returns a pointer to the prettified text as held by dsv.
Returns a pointer to the prettified text as held by dsv.
@@
-324,13
+342,18
@@
Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
-
+
+ PERL_ARGS_ASSERT_PV_PRETTY;
+
+ if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
+ /* This won't alter the UTF-8 flag */
+ sv_setpvn(dsv, "", 0);
+ }
+
if ( dq == '"' )
if ( dq == '"' )
- sv_
se
tpvn(dsv, "\"", 1);
+ sv_
ca
tpvn(dsv, "\"", 1);
else if ( flags & PERL_PV_PRETTY_LTGT )
else if ( flags & PERL_PV_PRETTY_LTGT )
- sv_setpvn(dsv, "<", 1);
- else
- sv_setpvn(dsv, "", 0);
+ sv_catpvn(dsv, "<", 1);
if ( start_color != NULL )
Perl_sv_catpv( aTHX_ dsv, start_color);
if ( start_color != NULL )
Perl_sv_catpv( aTHX_ dsv, start_color);
@@
-345,7
+368,7
@@
Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
else if ( flags & PERL_PV_PRETTY_LTGT )
sv_catpvn( dsv, ">", 1);
else if ( flags & PERL_PV_PRETTY_LTGT )
sv_catpvn( dsv, ">", 1);
- if ( (flags & PERL_PV_PRETTY_ELIPSES) && ( escaped < count ) )
+ if ( (flags & PERL_PV_PRETTY_EL
L
IPSES) && ( escaped < count ) )
sv_catpvn( dsv, "...", 3 );
return SvPVX(dsv);
sv_catpvn( dsv, "...", 3 );
return SvPVX(dsv);
@@
-372,6
+395,8
@@
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)
{
char *
Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
{
+ PERL_ARGS_ASSERT_PV_DISPLAY;
+
pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
if (len > cur && pv[cur] == '\0')
sv_catpvn( dsv, "\\0", 2 );
pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
if (len > cur && pv[cur] == '\0')
sv_catpvn( dsv, "\\0", 2 );
@@
-491,7
+516,7
@@
Perl_sv_peek(pTHX_ SV *sv)
Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
if (SvUTF8(sv))
Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
if (SvUTF8(sv))
Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
- sv_uni_display(tmp, sv,
8 * sv_len_utf8
(sv),
+ sv_uni_display(tmp, sv,
6 * SvCUR
(sv),
UNI_DISPLAY_QQ));
SvREFCNT_dec(tmp);
}
UNI_DISPLAY_QQ));
SvREFCNT_dec(tmp);
}
@@
-521,6
+546,8
@@
Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
{
char ch;
{
char ch;
+ PERL_ARGS_ASSERT_DO_PMOP_DUMP;
+
if (!pm) {
Perl_dump_indent(aTHX_ level, file, "{}\n");
return;
if (!pm) {
Perl_dump_indent(aTHX_ level, file, "{}\n");
return;
@@
-533,7
+560,7
@@
Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
ch = '/';
if (PM_GETRE(pm))
Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
ch = '/';
if (PM_GETRE(pm))
Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%s%c%s\n",
- ch,
PM_GETRE(pm)->precomp
, ch,
+ ch,
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");
@@
-541,7
+568,7
@@
Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
op_dump(pm->op_pmreplrootu.op_pmreplroot);
}
Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
op_dump(pm->op_pmreplrootu.op_pmreplroot);
}
- if (pm->op_pmflags || (PM_GETRE(pm) &&
PM_GETRE(pm)->check_substr
)) {
+ if (pm->op_pmflags || (PM_GETRE(pm) &&
RX_CHECK_SUBSTR(PM_GETRE(pm))
)) {
SV * const tmpsv = pm_description(pm);
Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
SV * const tmpsv = pm_description(pm);
Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
@@
-557,6
+584,8
@@
S_pm_description(pTHX_ const PMOP *pm)
const REGEXP * const regex = PM_GETRE(pm);
const U32 pmflags = pm->op_pmflags;
const REGEXP * const regex = PM_GETRE(pm);
const U32 pmflags = pm->op_pmflags;
+ PERL_ARGS_ASSERT_PM_DESCRIPTION;
+
if (pmflags & PMf_ONCE)
sv_catpv(desc, ",ONCE");
#ifdef USE_ITHREADS
if (pmflags & PMf_ONCE)
sv_catpv(desc, ",ONCE");
#ifdef USE_ITHREADS
@@
-568,15
+597,15
@@
S_pm_description(pTHX_ const PMOP *pm)
#endif
if (regex) {
#endif
if (regex) {
- if (
regex->extflags
& RXf_TAINTED)
+ if (
RX_EXTFLAGS(regex)
& RXf_TAINTED)
sv_catpv(desc, ",TAINTED");
sv_catpv(desc, ",TAINTED");
- if (
regex->check_substr
) {
- if (!(
regex->extflags
& RXf_NOSCAN))
+ if (
RX_CHECK_SUBSTR(regex)
) {
+ if (!(
RX_EXTFLAGS(regex)
& RXf_NOSCAN))
sv_catpv(desc, ",SCANFIRST");
sv_catpv(desc, ",SCANFIRST");
- if (
regex->extflags
& RXf_CHECK_ALL)
+ if (
RX_EXTFLAGS(regex)
& RXf_CHECK_ALL)
sv_catpv(desc, ",ALL");
}
sv_catpv(desc, ",ALL");
}
- if (
regex->extflags
& RXf_SKIPWHITE)
+ if (
RX_EXTFLAGS(regex)
& RXf_SKIPWHITE)
sv_catpv(desc, ",SKIPWHITE");
}
sv_catpv(desc, ",SKIPWHITE");
}
@@
-631,7
+660,7
@@
S_sequence(pTHX_ register const OP *o)
switch (o->op_type) {
case OP_STUB:
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
switch (o->op_type) {
case OP_STUB:
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
- hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
+
(void)
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
}
goto nothin;
break;
}
goto nothin;
@@
-649,7
+678,7
@@
S_sequence(pTHX_ register const OP *o)
nothin:
if (oldop && o->op_next)
continue;
nothin:
if (oldop && o->op_next)
continue;
- hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
+
(void)
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
case OP_MAPWHILE:
break;
case OP_MAPWHILE:
@@
-662,20
+691,20
@@
S_sequence(pTHX_ register const OP *o)
case OP_DORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
case OP_DORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
- hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
+
(void)
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
sequence_tail(cLOGOPo->op_other);
break;
case OP_ENTERLOOP:
case OP_ENTERITER:
sequence_tail(cLOGOPo->op_other);
break;
case OP_ENTERLOOP:
case OP_ENTERITER:
- hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
+
(void)
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
sequence_tail(cLOOPo->op_redoop);
sequence_tail(cLOOPo->op_nextop);
sequence_tail(cLOOPo->op_lastop);
break;
case OP_SUBST:
sequence_tail(cLOOPo->op_redoop);
sequence_tail(cLOOPo->op_nextop);
sequence_tail(cLOOPo->op_lastop);
break;
case OP_SUBST:
- hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
+
(void)
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
sequence_tail(cPMOPo->op_pmstashstartu.op_pmreplstart);
break;
sequence_tail(cPMOPo->op_pmstashstartu.op_pmreplstart);
break;
@@
-685,7
+714,7
@@
S_sequence(pTHX_ register const OP *o)
break;
default:
break;
default:
- hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
+
(void)
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
break;
}
oldop = o;
break;
}
oldop = o;
@@
-722,6
+751,8
@@
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
UV seq;
const OPCODE optype = o->op_type;
UV seq;
const OPCODE optype = o->op_type;
+ PERL_ARGS_ASSERT_DO_OP_DUMP;
+
sequence(o);
Perl_dump_indent(aTHX_ level, file, "{\n");
level++;
sequence(o);
Perl_dump_indent(aTHX_ level, file, "{\n");
level++;
@@
-951,7
+982,7
@@
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
- if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
+ if (OP_IS_FILETEST_ACCESS(o
->op_type
) && o->op_private & OPpFT_ACCESS)
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
sv_catpv(tmpsv, ",FT_STACKED");
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
sv_catpv(tmpsv, ",FT_STACKED");
@@
-1034,6
+1065,7
@@
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
#endif
break;
case OP_CONST:
#endif
break;
case OP_CONST:
+ case OP_HINTSEVAL:
case OP_METHOD_NAMED:
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
case OP_METHOD_NAMED:
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
@@
-1041,7
+1073,6
@@
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
#endif
break;
Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
#endif
break;
- case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopLINE(cCOPo))
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopLINE(cCOPo))
@@
-1112,6
+1143,7
@@
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
void
Perl_op_dump(pTHX_ const OP *o)
{
void
Perl_op_dump(pTHX_ const OP *o)
{
+ PERL_ARGS_ASSERT_OP_DUMP;
do_op_dump(0, Perl_debug_log, o);
}
do_op_dump(0, Perl_debug_log, o);
}
@@
-1120,6
+1152,8
@@
Perl_gv_dump(pTHX_ GV *gv)
{
SV *sv;
{
SV *sv;
+ PERL_ARGS_ASSERT_GV_DUMP;
+
if (!gv) {
PerlIO_printf(Perl_debug_log, "{}\n");
return;
if (!gv) {
PerlIO_printf(Perl_debug_log, "{}\n");
return;
@@
-1177,7
+1211,7
@@
static const struct { const char type; const char *name; } magic_names[] = {
{ PERL_MAGIC_qr, "qr(r)" },
{ PERL_MAGIC_sigelem, "sigelem(s)" },
{ PERL_MAGIC_taint, "taint(t)" },
{ PERL_MAGIC_qr, "qr(r)" },
{ PERL_MAGIC_sigelem, "sigelem(s)" },
{ PERL_MAGIC_taint, "taint(t)" },
- { PERL_MAGIC_uvar_elem, "uvar_elem(
v
)" },
+ { PERL_MAGIC_uvar_elem, "uvar_elem(
u
)" },
{ PERL_MAGIC_vec, "vec(v)" },
{ PERL_MAGIC_vstring, "vstring(V)" },
{ PERL_MAGIC_utf8, "utf8(w)" },
{ PERL_MAGIC_vec, "vec(v)" },
{ PERL_MAGIC_vstring, "vstring(V)" },
{ PERL_MAGIC_utf8, "utf8(w)" },
@@
-1191,6
+1225,8
@@
static const struct { const char type; const char *name; } magic_names[] = {
void
Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
void
Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
+ PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
+
for (; mg; mg = mg->mg_moremagic) {
Perl_dump_indent(aTHX_ level, file,
" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
for (; mg; mg = mg->mg_moremagic) {
Perl_dump_indent(aTHX_ level, file,
" MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
@@
-1272,16
+1308,17
@@
Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
PTR2UV(mg->mg_obj));
if (mg->mg_type == PERL_MAGIC_qr) {
Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n",
PTR2UV(mg->mg_obj));
if (mg->mg_type == PERL_MAGIC_qr) {
-
const regexp * const re = (regexp
*)mg->mg_obj;
+
REGEXP* const re = (REGEXP
*)mg->mg_obj;
SV * const dsv = sv_newmortal();
SV * const dsv = sv_newmortal();
- const char * const s = pv_pretty(dsv, re->wrapped, re->wraplen,
+ const char * const s
+ = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re),
60, NULL, NULL,
60, NULL, NULL,
- ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELIPSES |
- (
(re->extflags & RXf_UTF8
) ? PERL_PV_ESCAPE_UNI : 0))
+ ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_EL
L
IPSES |
+ (
RX_UTF8(re
) ? PERL_PV_ESCAPE_UNI : 0))
);
Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
);
Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s);
Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %"IVdf"\n",
- (IV)
re->refcnt
);
+ (IV)
RX_REFCNT(re)
);
}
if (mg->mg_flags & MGf_REFCOUNTED)
do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
}
if (mg->mg_flags & MGf_REFCOUNTED)
do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
@@
-1331,6
+1368,9
@@
void
Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
{
const char *hvname;
Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
{
const char *hvname;
+
+ PERL_ARGS_ASSERT_DO_HV_DUMP;
+
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && (hvname = HvNAME_get(sv)))
PerlIO_printf(file, "\t\"%s\"\n", hvname);
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && (hvname = HvNAME_get(sv)))
PerlIO_printf(file, "\t\"%s\"\n", hvname);
@@
-1341,6
+1381,8
@@
Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
void
Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
{
void
Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
{
+ PERL_ARGS_ASSERT_DO_GV_DUMP;
+
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv))
PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv))
PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv));
@@
-1351,6
+1393,8
@@
Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
void
Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
{
void
Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
{
+ PERL_ARGS_ASSERT_DO_GVGV_DUMP;
+
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv)) {
const char *hvname;
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv)) {
const char *hvname;
@@
-1372,6
+1416,8
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
U32 flags;
U32 type;
U32 flags;
U32 type;
+ PERL_ARGS_ASSERT_DO_SV_DUMP;
+
if (!sv) {
Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
return;
if (!sv) {
Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
return;
@@
-1518,7
+1564,7
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
}
if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
&& type != SVt_PVCV && !isGV_with_GP(sv))
}
if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
&& type != SVt_PVCV && !isGV_with_GP(sv))
- ||
type == SVt_IV
) {
+ ||
(type == SVt_IV && !SvROK(sv))
) {
if (SvIsUV(sv)
#ifdef PERL_OLD_COPY_ON_WRITE
|| SvIsCOW(sv)
if (SvIsUV(sv)
#ifdef PERL_OLD_COPY_ON_WRITE
|| SvIsCOW(sv)
@@
-1527,8
+1573,6
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
else
Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
else
Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
- if (SvOOK(sv))
- PerlIO_printf(file, " (OFFSET)");
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW_shared_hash(sv))
PerlIO_printf(file, " (HASH)");
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW_shared_hash(sv))
PerlIO_printf(file, " (HASH)");
@@
-1543,8
+1587,8
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
(UV) COP_SEQ_RANGE_HIGH(sv));
} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
(UV) COP_SEQ_RANGE_HIGH(sv));
} else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
- && type != SVt_PVCV && type != SVt_PVFM
&& !isGV_with_GP(sv)
- && !SvVALID(sv))
+ && type != SVt_PVCV && type != SVt_PVFM
&& type != SVt_REGEXP
+ &&
type != SVt_PVIO && !isGV_with_GP(sv) &&
!SvVALID(sv))
|| type == SVt_NV) {
STORE_NUMERIC_LOCAL_SET_STANDARD();
/* %Vg doesn't work? --jhi */
|| type == SVt_NV) {
STORE_NUMERIC_LOCAL_SET_STANDARD();
/* %Vg doesn't work? --jhi */
@@
-1566,12
+1610,23
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
}
if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
if (SvPVX_const(sv)) {
}
if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
if (SvPVX_const(sv)) {
+ STRLEN delta;
+ if (SvOOK(sv)) {
+ SvOOK_offset(sv, delta);
+ Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n",
+ (UV) delta);
+ } else {
+ delta = 0;
+ }
Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX_const(sv)));
- if (SvOOK(sv))
- PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
+ if (SvOOK(sv)) {
+ PerlIO_printf(file, "( %s . ) ",
+ pv_display(d, SvPVX_const(sv) - delta, delta, 0,
+ pvlim));
+ }
PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim));
- if (SvUTF8(sv)) /* the
8
? \x{....} */
- PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv,
8 * sv_len_utf8
(sv), UNI_DISPLAY_QQ));
+ 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));
Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
PerlIO_printf(file, "\n");
Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
@@
-1579,6
+1634,12
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
else
Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
}
else
Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
}
+ if (type == SVt_REGEXP) {
+ /* FIXME dumping
+ Perl_dump_indent(aTHX_ level, file, " REGEXP = 0x%"UVxf"\n",
+ PTR2UV(((struct regexp *)SvANY(sv))->xrx_regexp));
+ */
+ }
if (type >= SVt_PVMG) {
if (type == SVt_PVMG && SvPAD_OUR(sv)) {
HV * const ost = SvOURSTASH(sv);
if (type >= SVt_PVMG) {
if (type == SVt_PVMG && SvPAD_OUR(sv)) {
HV * const ost = SvOURSTASH(sv);
@@
-1716,7
+1777,7
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
if (SvUTF8(keysv))
Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
if (SvUTF8(keysv))
- PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv,
8 * sv_len_utf8
(keysv), UNI_DISPLAY_QQ));
+ PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv,
6 * SvCUR
(keysv), UNI_DISPLAY_QQ));
if (HeKREHASH(he))
PerlIO_printf(file, "[REHASH] ");
PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
if (HeKREHASH(he))
PerlIO_printf(file, "[REHASH] ");
PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash);
@@
-1865,7
+1926,6
@@
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
dumpops, pvlim);
}
do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
dumpops, pvlim);
}
- Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv));
if (isPRINT(IoTYPE(sv)))
Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
else
if (isPRINT(IoTYPE(sv)))
Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
else
@@
-1880,7
+1940,13
@@
void
Perl_sv_dump(pTHX_ SV *sv)
{
dVAR;
Perl_sv_dump(pTHX_ SV *sv)
{
dVAR;
- do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
+
+ PERL_ARGS_ASSERT_SV_DUMP;
+
+ if (SvROK(sv))
+ do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
+ else
+ do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
}
int
}
int
@@
-1926,12
+1992,16
@@
I32
Perl_debop(pTHX_ const OP *o)
{
dVAR;
Perl_debop(pTHX_ const OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_DEBOP;
+
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
Perl_deb(aTHX_ "%s", OP_NAME(o));
switch (o->op_type) {
case OP_CONST:
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
Perl_deb(aTHX_ "%s", OP_NAME(o));
switch (o->op_type) {
case OP_CONST:
+ case OP_HINTSEVAL:
PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
break;
case OP_GVSV:
PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
break;
case OP_GVSV:
@@
-1997,6
+2067,9
@@
void
Perl_watch(pTHX_ char **addr)
{
dVAR;
Perl_watch(pTHX_ char **addr)
{
dVAR;
+
+ PERL_ARGS_ASSERT_WATCH;
+
PL_watchaddr = addr;
PL_watchok = *addr;
PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
PL_watchaddr = addr;
PL_watchok = *addr;
PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
@@
-2007,6
+2080,9
@@
STATIC void
S_debprof(pTHX_ const OP *o)
{
dVAR;
S_debprof(pTHX_ const OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_DEBPROF;
+
if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
return;
if (!PL_profiledata)
if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
return;
if (!PL_profiledata)
@@
-2038,6
+2114,9
@@
STATIC void
S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
+
+ PERL_ARGS_ASSERT_XMLDUMP_ATTR;
+
PerlIO_printf(file, "\n ");
va_start(args, pat);
xmldump_vindent(level, file, pat, &args);
PerlIO_printf(file, "\n ");
va_start(args, pat);
xmldump_vindent(level, file, pat, &args);
@@
-2049,6
+2128,7
@@
void
Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
va_list args;
+ PERL_ARGS_ASSERT_XMLDUMP_INDENT;
va_start(args, pat);
xmldump_vindent(level, file, pat, &args);
va_end(args);
va_start(args, pat);
xmldump_vindent(level, file, pat, &args);
va_end(args);
@@
-2057,6
+2137,8
@@
Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
void
Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
void
Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
+ PERL_ARGS_ASSERT_XMLDUMP_VINDENT;
+
PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
}
PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
}
@@
-2078,6
+2160,8
@@
Perl_xmldump_packsubs(pTHX_ const HV *stash)
I32 i;
HE *entry;
I32 i;
HE *entry;
+ PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS;
+
if (!HvARRAY(stash))
return;
for (i = 0; i <= (I32) HvMAX(stash); i++) {
if (!HvARRAY(stash))
return;
for (i = 0; i <= (I32) HvMAX(stash); i++) {
@@
-2102,7
+2186,9
@@
Perl_xmldump_sub(pTHX_ const GV *gv)
{
SV * const sv = sv_newmortal();
{
SV * const sv = sv_newmortal();
- gv_fullname3(sv, gv, Nullch);
+ PERL_ARGS_ASSERT_XMLDUMP_SUB;
+
+ gv_fullname3(sv, gv, NULL);
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
if (CvXSUB(GvCV(gv)))
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
if (CvXSUB(GvCV(gv)))
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
@@
-2119,7
+2205,9
@@
Perl_xmldump_form(pTHX_ const GV *gv)
{
SV * const sv = sv_newmortal();
{
SV * const sv = sv_newmortal();
- gv_fullname3(sv, gv, Nullch);
+ PERL_ARGS_ASSERT_XMLDUMP_FORM;
+
+ gv_fullname3(sv, gv, NULL);
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
if (CvROOT(GvFORM(gv)))
op_xmldump(CvROOT(GvFORM(gv)));
Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
if (CvROOT(GvFORM(gv)))
op_xmldump(CvROOT(GvFORM(gv)));
@@
-2136,6
+2224,7
@@
Perl_xmldump_eval(pTHX)
char *
Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
{
char *
Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
{
+ PERL_ARGS_ASSERT_SV_CATXMLSV;
return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
}
return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv));
}
@@
-2148,6
+2237,8
@@
Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
STRLEN dsvcur;
STRLEN cl;
STRLEN dsvcur;
STRLEN cl;
+ PERL_ARGS_ASSERT_SV_CATXMLPVN;
+
sv_catpvn(dsv,"",0);
dsvcur = SvCUR(dsv); /* in case we have to restart */
sv_catpvn(dsv,"",0);
dsvcur = SvCUR(dsv); /* in case we have to restart */
@@
-2224,16
+2315,16
@@
Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
break;
case '<':
Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
break;
case '<':
-
Perl_sv_catpvf(aTHX_
dsv, "<");
+
sv_catpvs(
dsv, "<");
break;
case '>':
break;
case '>':
-
Perl_sv_catpvf(aTHX_
dsv, ">");
+
sv_catpvs(
dsv, ">");
break;
case '&':
break;
case '&':
-
Perl_sv_catpvf(aTHX_
dsv, "&");
+
sv_catpvs(
dsv, "&");
break;
case '"':
break;
case '"':
-
Perl_sv_catpvf(aTHX_
dsv, """);
+
sv_catpvs(
dsv, """);
break;
default:
if (c < 0xD800) {
break;
default:
if (c < 0xD800) {
@@
-2241,7
+2332,8
@@
Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
}
else {
Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
}
else {
- Perl_sv_catpvf(aTHX_ dsv, "%c", c);
+ const char string = (char) c;
+ sv_catpvn(dsv, &string, 1);
}
break;
}
}
break;
}
@@
-2270,6
+2362,8
@@
Perl_sv_xmlpeek(pTHX_ SV *sv)
STRLEN n_a;
int unref = 0;
STRLEN n_a;
int unref = 0;
+ PERL_ARGS_ASSERT_SV_XMLPEEK;
+
sv_utf8_upgrade(t);
sv_setpvn(t, "", 0);
/* retry: */
sv_utf8_upgrade(t);
sv_setpvn(t, "", 0);
/* retry: */
@@
-2357,9
+2451,6
@@
Perl_sv_xmlpeek(pTHX_ SV *sv)
case SVt_NV:
sv_catpv(t, " NV=\"");
break;
case SVt_NV:
sv_catpv(t, " NV=\"");
break;
- case SVt_RV:
- sv_catpv(t, " RV=\"");
- break;
case SVt_PV:
sv_catpv(t, " PV=\"");
break;
case SVt_PV:
sv_catpv(t, " PV=\"");
break;
@@
-2393,6
+2484,9
@@
Perl_sv_xmlpeek(pTHX_ SV *sv)
case SVt_BIND:
sv_catpv(t, " BIND=\"");
break;
case SVt_BIND:
sv_catpv(t, " BIND=\"");
break;
+ case SVt_REGEXP:
+ sv_catpv(t, " ORANGE=\"");
+ break;
case SVt_PVFM:
sv_catpv(t, " FM=\"");
break;
case SVt_PVFM:
sv_catpv(t, " FM=\"");
break;
@@
-2430,6
+2524,8
@@
Perl_sv_xmlpeek(pTHX_ SV *sv)
void
Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
{
void
Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
{
+ PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP;
+
if (!pm) {
Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
return;
if (!pm) {
Perl_xmldump_indent(aTHX_ level, file, "<pmop/>\n");
return;
@@
-2437,10
+2533,9
@@
Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
level++;
if (PM_GETRE(pm)) {
Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
level++;
if (PM_GETRE(pm)) {
- const char * const s = PM_GETRE(pm)->precomp;
- SV * const tmpsv = newSVpvn("",0);
- SvUTF8_on(tmpsv);
- sv_catxmlpvn(tmpsv, s, strlen(s), 1);
+ REGEXP *const r = PM_GETRE(pm);
+ SV * const tmpsv = newSVsv((SV*)r);
+ sv_utf8_upgrade(tmpsv);
Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
SvPVX(tmpsv));
SvREFCNT_dec(tmpsv);
Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
SvPVX(tmpsv));
SvREFCNT_dec(tmpsv);
@@
-2449,7
+2544,7
@@
Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
}
else
Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
}
else
Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
- if (pm->op_pmflags || (PM_GETRE(pm) &&
PM_GETRE(pm)->check_substr
)) {
+ if (pm->op_pmflags || (PM_GETRE(pm) &&
RX_CHECK_SUBSTR(PM_GETRE(pm))
)) {
SV * const tmpsv = pm_description(pm);
Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
SV * const tmpsv = pm_description(pm);
Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
@@
-2478,6
+2573,9
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
{
UV seq;
int contents = 0;
{
UV seq;
int contents = 0;
+
+ PERL_ARGS_ASSERT_DO_OP_XMLDUMP;
+
if (!o)
return;
sequence(o);
if (!o)
return;
sequence(o);
@@
-2702,7
+2800,7
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) {
- if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS)
+ if (OP_IS_FILETEST_ACCESS(o
->op_type
) && o->op_private & OPpFT_ACCESS)
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
sv_catpv(tmpsv, ",FT_STACKED");
sv_catpv(tmpsv, ",FT_ACCESS");
if (o->op_private & OPpFT_STACKED)
sv_catpv(tmpsv, ",FT_STACKED");
@@
-2725,16
+2823,14
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
#else
if (cSVOPo->op_sv) {
S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
#else
if (cSVOPo->op_sv) {
- SV * const tmpsv1 = newSV
(0
);
- SV * const tmpsv2 = newSVpvn
("",0
);
+ SV * const tmpsv1 = newSV
pvn_utf8(NULL, 0, TRUE
);
+ SV * const tmpsv2 = newSVpvn
_utf8("", 0, TRUE
);
char *s;
STRLEN len;
char *s;
STRLEN len;
- SvUTF8_on(tmpsv1);
- SvUTF8_on(tmpsv2);
ENTER;
SAVEFREESV(tmpsv1);
SAVEFREESV(tmpsv2);
ENTER;
SAVEFREESV(tmpsv1);
SAVEFREESV(tmpsv2);
- gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, N
ullch
);
+ gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, N
ULL
);
s = SvPV(tmpsv1,len);
sv_catxmlpvn(tmpsv2, s, len, 1);
S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
s = SvPV(tmpsv1,len);
sv_catxmlpvn(tmpsv2, s, len, 1);
S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));
@@
-2745,6
+2841,7
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
#endif
break;
case OP_CONST:
#endif
break;
case OP_CONST:
+ case OP_HINTSEVAL:
case OP_METHOD_NAMED:
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
case OP_METHOD_NAMED:
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
@@
-2759,7
+2856,6
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
}
do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
break;
}
do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv));
break;
- case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopLINE(cCOPo))
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopLINE(cCOPo))
@@
-2816,10
+2912,9
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
if (PL_madskills && o->op_madprop) {
char prevkey = '\0';
if (PL_madskills && o->op_madprop) {
char prevkey = '\0';
- SV * const tmpsv = newSVpvn
("", 0
);
+ SV * const tmpsv = newSVpvn
_utf8("", 0, TRUE
);
const MADPROP* mp = o->op_madprop;
const MADPROP* mp = o->op_madprop;
- sv_utf8_upgrade(tmpsv);
if (!contents) {
contents = 1;
PerlIO_printf(file, ">\n");
if (!contents) {
contents = 1;
PerlIO_printf(file, ">\n");
@@
-2906,6
+3001,8
@@
Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
void
Perl_op_xmldump(pTHX_ const OP *o)
{
void
Perl_op_xmldump(pTHX_ const OP *o)
{
+ PERL_ARGS_ASSERT_OP_XMLDUMP;
+
do_op_xmldump(0, PL_xmlfp, o);
}
#endif
do_op_xmldump(0, PL_xmlfp, o);
}
#endif