diff options
author | David Mitchell <davem@iabyn.com> | 2013-03-23 23:05:18 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2013-03-23 23:07:22 +0000 |
commit | 17605be794d9a6ceaaa8a5cc2afcf09dd2e8ccff (patch) | |
tree | e214b083db4aea822896360847ad8b04349bf453 | |
parent | a431a7fe2125b48581508ba742bf38e571bef1e1 (diff) | |
download | perl-17605be794d9a6ceaaa8a5cc2afcf09dd2e8ccff.tar.gz |
Revert "fix Peek.t to work with NEW COW"
This reverts commit 2b656fcc48f28912136698c28b3bd916c42d74f8.
I accidentally included the changes I was reviewing from a patch of
Reini's
-rw-r--r-- | dump.c | 67 | ||||
-rw-r--r-- | ext/Devel-Peek/t/Peek.t | 3 | ||||
-rw-r--r-- | ext/XS-APItest/t/svpeek.t | 10 |
3 files changed, 34 insertions, 46 deletions
@@ -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}'); } |