summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dump.c67
-rw-r--r--ext/Devel-Peek/t/Peek.t3
-rw-r--r--ext/XS-APItest/t/svpeek.t10
3 files changed, 34 insertions, 46 deletions
diff --git a/dump.c b/dump.c
index eab747cb83..fcc63fcd8f 100644
--- a/dump.c
+++ b/dump.c
@@ -85,6 +85,8 @@ S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start,
#define append_flags(sv, f, flags) \
S_append_flags(aTHX_ (sv), (f), (flags), C_ARRAY_END(flags))
+
+
void
Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
@@ -531,10 +533,7 @@ Perl_sv_peek(pTHX_ SV *sv)
}
type = SvTYPE(sv);
if (type == SVt_PVCV) {
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
- Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ?
- pv_display(tmp, GvNAME_get(CvGV(sv)), GvNAMELEN_get(CvGV(sv)), 0, 127)
- : "");
+ Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
goto finish;
} else if (type < SVt_LAST) {
sv_catpv(t, svshorttypenames[type]);
@@ -550,7 +549,7 @@ Perl_sv_peek(pTHX_ SV *sv)
if (!SvPVX_const(sv))
sv_catpv(t, "(null)");
else {
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
+ SV * const tmp = newSVpvs("");
sv_catpv(t, "(");
if (SvOOK(sv)) {
STRLEN delta;
@@ -562,6 +561,7 @@ Perl_sv_peek(pTHX_ SV *sv)
Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]",
sv_uni_display(tmp, sv, 6 * SvCUR(sv),
UNI_DISPLAY_QQ));
+ SvREFCNT_dec_NN(tmp);
}
}
else if (SvNOKp(sv)) {
@@ -839,7 +839,7 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
#define DUMP_OP_FLAGS(o,xml,level,file) \
if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { \
- SV * const tmpsv = newSVpvs_flags("", SVs_TEMP); \
+ SV * const tmpsv = newSVpvs(""); \
switch (o->op_flags & OPf_WANT) { \
case OPf_WANT_VOID: \
sv_catpv(tmpsv, ",VOID"); \
@@ -878,7 +878,7 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
if (o->op_private) { \
U32 optype = o->op_type; \
U32 oppriv = o->op_private; \
- SV * const tmpsv = newSVpvs_flags("", SVs_TEMP); \
+ SV * const tmpsv = newSVpvs(""); \
if (PL_opargs[optype] & OA_TARGLEX) { \
if (oppriv & OPpTARGET_MY) \
sv_catpv(tmpsv, ",TARGET_MY"); \
@@ -1014,7 +1014,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
#ifdef PERL_MAD
if (PL_madskills && o->op_madprop) {
- SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
+ SV * const tmpsv = newSVpvs("");
MADPROP* mp = o->op_madprop;
Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
level++;
@@ -1065,7 +1065,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */
if (cSVOPo->op_sv) {
SV * const tmpsv = newSV(0);
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
ENTER;
SAVEFREESV(tmpsv);
#ifdef PERL_MAD
@@ -1075,7 +1074,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
#endif
gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL);
Perl_dump_indent(aTHX_ level, file, "GV = %s\n",
- pv_display(tmp, SvPVX_const(tmpsv), SvCUR(tmpsv), SvLEN(tmpsv), 127));
+ SvPV_nolen_const(tmpsv));
LEAVE;
}
else
@@ -1169,7 +1168,7 @@ Perl_op_dump(pTHX_ const OP *o)
void
Perl_gv_dump(pTHX_ GV *gv)
{
- SV *sv, *tmp;
+ SV *sv;
PERL_ARGS_ASSERT_GV_DUMP;
@@ -1178,15 +1177,12 @@ Perl_gv_dump(pTHX_ GV *gv)
return;
}
sv = sv_newmortal();
- tmp = newSVpvs_flags("", SVs_TEMP);
PerlIO_printf(Perl_debug_log, "{\n");
gv_fullname3(sv, gv, NULL);
- Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s",
- pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
+ Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX_const(sv));
if (gv != GvEGV(gv)) {
gv_efullname3(sv, GvEGV(gv), NULL);
- Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
- pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127));
+ Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX_const(sv));
}
PerlIO_putc(Perl_debug_log, '\n');
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
@@ -1288,8 +1284,9 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
if (mg->mg_len >= 0) {
if (mg->mg_type != PERL_MAGIC_utf8) {
- SV * const sv = newSVpvs_flags("", SVs_TEMP);
+ SV * const sv = newSVpvs("");
PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
+ SvREFCNT_dec_NN(sv);
}
}
else if (mg->mg_len == HEf_SVKEY) {
@@ -1342,7 +1339,7 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
name which quite legally could contain insane things like tabs, newlines, nulls or
other scary crap - this should produce sane results - except maybe for unicode package
names - but we will wait for someone to file a bug on that - demerphq */
- SV * const tmpsv = newSVpvs_flags("", SVs_TEMP);
+ SV * const tmpsv = newSVpvs("");
PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
}
else
@@ -1368,15 +1365,11 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv)) {
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
const char *hvname;
- HV * const stash = GvSTASH(sv);
- PerlIO_printf(file, "\t");
- if (stash && (hvname = HvNAME_get(stash)))
- PerlIO_printf(file, "%s :: ",
- pv_display(tmp, hvname, HvNAMELEN_get(stash), 0, 127));
- PerlIO_printf(file, "%s\n",
- pv_display(tmp, GvNAME(sv), GvNAMELEN_get(sv), 0, 127));
+ PerlIO_printf(file, "\t\"");
+ if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
+ PerlIO_printf(file, "%s\" :: \"", hvname);
+ PerlIO_printf(file, "%s\"\n", GvNAME(sv));
}
else
PerlIO_putc(file, '\n');
@@ -1817,11 +1810,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
}
}
{
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
const char * const hvname = HvNAME_get(sv);
- if (HvNAMELEN_get(sv))
- Perl_dump_indent(aTHX_ level, file, " NAME = %s\n",
- pv_display(tmp, hvname, HvNAMELEN_get(sv), 0, 127));
+ if (hvname)
+ Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
}
if (SvOOK(sv)) {
AV * const backrefs
@@ -1835,7 +1826,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) {
const I32 count = HvAUX(sv)->xhv_name_count;
if (count) {
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
SV * const names = newSVpvs_flags("", SVs_TEMP);
/* The starting point is the first element if count is
positive and the second element if count is negative. */
@@ -1844,9 +1834,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names
+ (count < 0 ? -count : count);
while (hekp < endp) {
- if (HEK_LEN(*hekp)) {
- Perl_sv_catpvf(aTHX_ names, ", %s",
- pv_display(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), 0, pvlim));
+ if (*hekp) {
+ sv_catpvs(names, ", \"");
+ sv_catpvn(names, HEK_KEY(*hekp), HEK_LEN(*hekp));
+ sv_catpvs(names, "\"");
} else {
/* This should never happen. */
sv_catpvs(names, ", (null)");
@@ -1857,12 +1848,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
level, file, " ENAME = %s\n", SvPV_nolen(names)+2
);
}
- else {
- SV * const tmp = newSVpvs_flags("", SVs_TEMP);
+ else
Perl_dump_indent(aTHX_
- level, file, " ENAME = %s\n",
- pv_display(tmp, HvENAME_get(sv), HvENAMELEN_get(sv), 0, pvlim));
- }
+ level, file, " ENAME = \"%s\"\n", HvENAME_get(sv)
+ );
}
if (backrefs) {
Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n",
diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 912bf8c1cb..116c204078 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -969,8 +969,7 @@ do_test('UTF-8 in a regular expression',
SUBSTRS = $ADDR
PPRIVATE = $ADDR
OFFS = $ADDR
- QR_ANONCV = 0x0(?:
- SAVED_COPY = 0x0)?
+ QR_ANONCV = 0x0
');
done_testing();
diff --git a/ext/XS-APItest/t/svpeek.t b/ext/XS-APItest/t/svpeek.t
index c8792b5019..59851d3bb4 100644
--- a/ext/XS-APItest/t/svpeek.t
+++ b/ext/XS-APItest/t/svpeek.t
@@ -44,7 +44,7 @@ like (DPeek ($1), qr'^PVMG\("', ' $1');
is (DPeek (\@INC), '\AV()', '\@INC');
is (DPeek (\%INC), '\HV()', '\%INC');
is (DPeek (*STDOUT), 'GV()', '*STDOUT');
- is (DPeek (sub {}), '\CV("__ANON__")', 'sub {}');
+ is (DPeek (sub {}), '\CV(__ANON__)', 'sub {}');
{ our ($VAR, @VAR, %VAR);
open VAR, "<", $^X or die "Can't open $^X: $!";
@@ -67,18 +67,18 @@ like (DPeek ($1), qr'^PVMG\("', ' $1');
is (DPeek ($VAR), 'PVIV("a\n\342\202\254"\0) [UTF8 "a\n\x{20ac}"]',
' $VAR "a\x0a\x{20ac}"');
$VAR = sub { "VAR" };
- is (DPeek ($VAR), '\CV("__ANON__")', ' $VAR sub { "VAR" }');
- is (DPeek (\$VAR), '\\\CV("__ANON__")', '\$VAR sub { "VAR" }');
+ is (DPeek ($VAR), '\CV(__ANON__)', ' $VAR sub { "VAR" }');
+ is (DPeek (\$VAR), '\\\CV(__ANON__)', '\$VAR sub { "VAR" }');
$VAR = 0;
- is (DPeek (\&VAR), '\CV("VAR")', '\&VAR');
+ is (DPeek (\&VAR), '\CV(VAR)', '\&VAR');
is (DPeek ( *VAR), 'GV()', ' *VAR');
is (DPeek (*VAR{GLOB}), '\GV()', ' *VAR{GLOB}');
like (DPeek (*VAR{SCALAR}), qr'\\PV(IV|MG)\(0\)',' *VAR{SCALAR}');
is (DPeek (*VAR{ARRAY}), '\AV()', ' *VAR{ARRAY}');
is (DPeek (*VAR{HASH}), '\HV()', ' *VAR{HASH}');
- is (DPeek (*VAR{CODE}), '\CV("VAR")', ' *VAR{CODE}');
+ is (DPeek (*VAR{CODE}), '\CV(VAR)', ' *VAR{CODE}');
is (DPeek (*VAR{IO}), '\IO()', ' *VAR{IO}');
is (DPeek (*VAR{FORMAT}),$]<5.008?'SV_UNDEF':'\FM()',' *VAR{FORMAT}');
}
View Lorry Controller Status