Referencing a PADTMP twice produces two copies #10690
Comments
From @cpansprout$ perl -le' for( "$y" ){print \$_.\$_}' (The same address should be printed twice.) It looks as though the TARG ought to be stolen by S_refto, and then replaced via pad_swipe or something similar. Flags: Site configuration information for perl 5.13.5: Configured by sprout at Mon Sep 27 23:15:22 PDT 2010. Summary of my perl5 (revision 5 version 13 subversion 5) configuration: Locally applied patches: @INC for perl 5.13.5: Environment for perl 5.13.5: |
From @cpansproutOn Sun Oct 03 14:08:37 2010, sprout wrote:
It might be cleaner for not only S_refto, but also any op that aliases a |
From [Unknown Contact. See original ticket]On Sun Oct 03 14:08:37 2010, sprout wrote:
It might be cleaner for not only S_refto, but also any op that aliases a |
|
@cpansprout - Status changed from 'new' to 'open' |
From @cpansproutOn Sun Jun 05 16:04:53 2011, sprout wrote:
Here is a difficult case: $ ./perl -Ilib -e 'use Devel::Peek; "$_" =~ /(?{ Dump $_ })/;' Fixing the operators I mentioned above is easy. Fixing patterns without Are regular expressions with code blocks in them flagged somehow, so we In case it’s not obvious, this is the bug I’m trying to fix: $ ./perl -Ilib -le '"$_" =~ /(?{ print \$_; print \$_ })/;' Taking a reference to $_ twice should not create references to two -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Sun Jun 05 16:04:53 2011, sprout wrote:
Here is a difficult case: $ ./perl -Ilib -e 'use Devel::Peek; "$_" =~ /(?{ Dump $_ })/;' Fixing the operators I mentioned above is easy. Fixing patterns without Are regular expressions with code blocks in them flagged somehow, so we In case it’s not obvious, this is the bug I’m trying to fix: $ ./perl -Ilib -le '"$_" =~ /(?{ print \$_; print \$_ })/;' Taking a reference to $_ twice should not create references to two -- Father Chrysostomos |
From @iabynOn Sun, Jan 08, 2012 at 02:21:34PM -0800, Father Chrysostomos via RT wrote:
yes, RXf_EVAL_SEEN. It's used at the start of S_regtry to decide whether
Confused the hell out me! :-) I didn't realise until I looked at it just -- |
From [email protected]On Sun Jan 08 14:21:34 2012, sprout wrote:
I'll add my PerlMonks discussion to this |
From [Unknown Contact. See original ticket]On Sun Jan 08 14:21:34 2012, sprout wrote:
I'll add my PerlMonks discussion to this |
From @cpansproutThis is related to #7505, which is one instance of this bug. |
From [Unknown Contact. See original ticket]This is related to #7505, which is one instance of this bug. |
From @cpansproutOn Sat Jun 15 13:49:57 2013, sprout wrote:
Um, nope, it’s not. Ignore that. -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Sat Jun 15 13:49:57 2013, sprout wrote:
Um, nope, it’s not. Ignore that. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
From @cpansproutOn Fri Jan 13 13:16:42 2012, patcat88 wrote:
This part is not resolved. I’m reopening it. -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Fri Jan 13 13:16:42 2012, patcat88 wrote:
This part is not resolved. I’m reopening it. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'resolved' to 'open' |
From @cpansproutOn Fri Jul 26 23:12:23 2013, sprout wrote:
I did not fix this bug for calls to XSUBs, because it will make (Here I’m referring to the original bug reported, not the newRV issue. Currently foo("$x") will make a COW copy of the TARG if it is a Perl I think the real solution here is to apply the fix to XSUBs (copy TARG That way the only XS code having access to TARGs will be that which In fact, having Devel::Peek inline itself would be useful for seeing the -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Fri Jul 26 23:12:23 2013, sprout wrote:
I did not fix this bug for calls to XSUBs, because it will make (Here I’m referring to the original bug reported, not the newRV issue. Currently foo("$x") will make a COW copy of the TARG if it is a Perl I think the real solution here is to apply the fix to XSUBs (copy TARG That way the only XS code having access to TARGs will be that which In fact, having Devel::Peek inline itself would be useful for seeing the -- Father Chrysostomos |
From @cpansproutOn Sat Jul 27 11:27:57 2013, sprout wrote:
Attached is a patch to get Devel::Peek to inline itself. It also allows It breaks compatibility in that ‘@args = ($thing, 5); Dump @args’ no I still think it is worth it. The patch can also be found on the sprout/peek branch. -- Father Chrysostomos |
From @cpansproutFrom b71bcee5cdd1e9dc06692914a330bb543cacc16b Mon Sep 17 00:00:00 2001 This commit makes Devel::Peek::Dump modify the op tree to allow it to Since a future commit (to fix the rest of #78194) is likely to make This does introduce a backward-incompatible change, in that both argu- Inline Patchdiff --git a/ext/Devel-Peek/Peek.xs b/ext/Devel-Peek/Peek.xs
index 4c5f974..edcb02f 100644
--- a/ext/Devel-Peek/Peek.xs
+++ b/ext/Devel-Peek/Peek.xs
@@ -323,6 +323,94 @@ mstats2hash(SV *sv, SV *rv, int level)
(SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV) \
? SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef)
+static void
+S_do_dump(pTHX_ SV *const sv, I32 lim)
+{
+ dVAR;
+ SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
+ const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
+ SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
+ const U16 save_dumpindent = PL_dumpindent;
+ PL_dumpindent = 2;
+ do_sv_dump(0, Perl_debug_log, sv, 0, lim,
+ (bool)(dumpop && SvTRUE(dumpop)), pv_lim);
+ PL_dumpindent = save_dumpindent;
+}
+
+static OP *
+S_pp_dump(pTHX)
+{
+ dSP;
+ const I32 lim = PL_op->op_private == 2 ? (I32)POPi : 4;
+ dPOPss;
+ S_do_dump(aTHX_ sv, lim);
+ RETPUSHUNDEF;
+}
+
+static OP *
+S_ck_dump(pTHX_ OP *entersubop, GV *namegv, SV *cv)
+{
+ OP *aop, *prev, *first, *second = NULL;
+ BINOP *newop;
+ size_t arg = 0;
+
+ ck_entersub_args_proto(entersubop, namegv,
+ newSVpvn_flags("$;$", 3, SVs_TEMP));
+
+ aop = cUNOPx(entersubop)->op_first;
+ if (!aop->op_sibling)
+ aop = cUNOPx(aop)->op_first;
+ prev = aop;
+ aop = aop->op_sibling;
+ while (PL_madskills && aop->op_type == OP_STUB) {
+ prev = aop;
+ aop = aop->op_sibling;
+ }
+ if (PL_madskills && aop->op_type == OP_NULL) {
+ first = ((UNOP*)aop)->op_first;
+ ((UNOP*)aop)->op_first = NULL;
+ prev = aop;
+ }
+ else {
+ first = aop;
+ prev->op_sibling = first->op_sibling;
+ }
+ if (first->op_type == OP_RV2AV ||
+ first->op_type == OP_PADAV ||
+ first->op_type == OP_RV2HV ||
+ first->op_type == OP_PADHV
+ )
+ first->op_flags |= OPf_REF;
+ else
+ first->op_flags &= ~OPf_MOD;
+ aop = aop->op_sibling;
+ while (PL_madskills && aop->op_type == OP_STUB) {
+ prev = aop;
+ aop = aop->op_sibling;
+ }
+ /* aop now points to the second arg if there is one, the cvop otherwise
+ */
+ if ((prev->op_sibling = aop->op_sibling)) {
+ second = aop;
+ second->op_sibling = NULL;
+ }
+ first->op_sibling = second;
+
+ op_free(entersubop);
+
+ NewOp(1234, newop, 1, BINOP);
+ newop->op_type = OP_CUSTOM;
+ newop->op_ppaddr = S_pp_dump;
+ newop->op_first = first;
+ newop->op_last = second;
+ newop->op_private= second ? 2 : 1;
+ newop->op_flags = OPf_KIDS|OPf_WANT_SCALAR;
+
+ return (OP *)newop;
+}
+
+static XOP my_xop;
+
MODULE = Devel::Peek PACKAGE = Devel::Peek
void
@@ -346,14 +434,18 @@ SV * sv
I32 lim
PPCODE:
{
- SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
- const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
- SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
- const U16 save_dumpindent = PL_dumpindent;
- PL_dumpindent = 2;
- do_sv_dump(0, Perl_debug_log, sv, 0, lim,
- (bool)(dumpop && SvTRUE(dumpop)), pv_lim);
- PL_dumpindent = save_dumpindent;
+ S_do_dump(aTHX_ sv, lim);
+}
+
+BOOT:
+{
+ CV * const cv = get_cvn_flags("Devel::Peek::Dump", 17, 0);
+ cv_set_call_checker(cv, S_ck_dump, (SV *)cv);
+
+ XopENTRY_set(&my_xop, xop_name, "Dump");
+ XopENTRY_set(&my_xop, xop_desc, "Dump");
+ XopENTRY_set(&my_xop, xop_class, OA_BINOP);
+ Perl_custom_op_register(aTHX_ S_pp_dump, &my_xop);
}
void
diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 088f505..1f344df 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -31,11 +31,24 @@ sub do_test {
my $todo = $_[3];
my $repeat_todo = $_[4];
my $pattern = $_[2];
+ my $do_eval = $_[5];
if (open(OUT,">peek$$")) {
open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
- Dump($_[1]);
- print STDERR "*****\n";
- Dump($_[1]); # second dump to compare with the first to make sure nothing changed.
+ if ($do_eval) {
+ my $sub = eval "sub { Dump $_[1] }";
+ $sub->();
+ print STDERR "*****\n";
+ # second dump to compare with the first to make sure nothing
+ # changed.
+ $sub->();
+ }
+ else {
+ Dump($_[1]);
+ print STDERR "*****\n";
+ # second dump to compare with the first to make sure nothing
+ # changed.
+ Dump($_[1]);
+ }
open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
close(OUT);
if (open(IN, "peek$$")) {
@@ -196,8 +209,8 @@ do_test('integer constant',
do_test('undef',
undef,
'SV = NULL\\(0x0\\) at $ADDR
- REFCNT = 1
- FLAGS = \\(\\)');
+ REFCNT = \d+
+ FLAGS = \\(READONLY\\)');
do_test('reference to scalar',
\$a,
@@ -335,6 +348,8 @@ do_test('reference to named subroutine without prototype',
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo"
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo"
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
+ \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$do_eval"
+ \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$sub"
\\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009
\\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
@@ -968,6 +983,59 @@ do_test('large hash',
Elt .*
');
+# Dump with arrays, hashes, and operator return values
+@array = 1..3;
+do_test('Dump @array', '@array', <<'ARRAY', '', '', 1);
+SV = PVAV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(\)
+ ARRAY = $ADDR
+ FILL = 2
+ MAX = 3
+ ARYLEN = 0x0
+ FLAGS = \(REAL\)
+ Elt No. 0
+ SV = IV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(IOK,pIOK\)
+ IV = 1
+ Elt No. 1
+ SV = IV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(IOK,pIOK\)
+ IV = 2
+ Elt No. 2
+ SV = IV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(IOK,pIOK\)
+ IV = 3
+ARRAY
+%hash = 1..2;
+do_test('Dump %hash', '%hash', <<'HASH', '', '', 1);
+SV = PVHV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(SHAREKEYS\)
+ ARRAY = $ADDR \(0:7, 1:1\)
+ hash quality = 100.0%
+ KEYS = 1
+ FILL = 1
+ MAX = 7
+ Elt "1" HASH = $ADDR
+ SV = IV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(IOK,pIOK\)
+ IV = 2
+HASH
+$_ = "hello";
+do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', '', 1);
+SV = PV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(PADTMP,POK,pPOK\)
+ PV = $ADDR "el"\\0
+ CUR = 2
+ LEN = 20
+SUBSTR
+
SKIP: {
skip "Not built with usemymalloc", 2
unless $Config{usemymalloc} eq 'y'; |
From [Unknown Contact. See original ticket]On Sat Jul 27 11:27:57 2013, sprout wrote:
Attached is a patch to get Devel::Peek to inline itself. It also allows It breaks compatibility in that ‘@args = ($thing, 5); Dump @args’ no I still think it is worth it. The patch can also be found on the sprout/peek branch. -- Father Chrysostomos |
From @HugmeirOn Mon, Aug 12, 2013 at 6:00 AM, Father Chrysostomos via RT <
This is unrelated to the thread, but I just wanted to say that looking over About the patch itself, I have never written Dump(@foo) and not meant
|
From @cpansproutOn Mon Aug 12 12:24:53 2013, Hugmeir wrote:
I just copied bits of XS::APItest and ck_entersub_args_proto. :-) -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Aug 12 12:24:53 2013, Hugmeir wrote:
I just copied bits of XS::APItest and ck_entersub_args_proto. :-) -- Father Chrysostomos |
From @ikegamiOn Mon, Aug 12, 2013 at 3:24 PM, Brian Fraser <fraserbn@gmail.com> wrote:
See also: Syntax::Feature::Loop |
From @ikegamioops, nevermind. That demonstrates custom keywords, custom parsing, On Mon, Aug 12, 2013 at 3:49 PM, Eric Brine <ikegami@adaelis.com> wrote:
|
From @cpansproutOn Mon Aug 12 02:00:18 2013, sprout wrote:
I have made that change in commit 3455055.
And I applied that patch, with a slight tweak (with one arg it was -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Aug 12 02:00:18 2013, sprout wrote:
I have made that change in commit 3455055.
And I applied that patch, with a slight tweak (with one arg it was -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
From @ikegamiOn Wed, Aug 14, 2013 at 11:24 AM, bulk88 via RT
Why do you think so? Do you think S_ck_dump gets called for every XSUB + CV * const cv = get_cvn_flags("Devel::Peek::Dump", 17, 0); |
From @bulk88On Wed Aug 14 09:11:42 2013, ikegami@adaelis.com wrote:
Whoops, I meant the patch in -- |
From @cpansproutOn Wed Aug 14 09:27:13 2013, bulk88 wrote:
(He means 3455055; see below.)
True, but the overhead is minuscule, just a quick scan and flag check in An alternative would be to fix this bug by having newRV copy anything Another way would be to modify ops that return PADTMPs not to return
http://perl5.git.perl.org/perl.git/commit/3455055faace06645b99a6ed63fce90144ab47e1
-- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Wed Aug 14 09:27:13 2013, bulk88 wrote:
(He means 3455055; see below.)
True, but the overhead is minuscule, just a quick scan and flag check in An alternative would be to fix this bug by having newRV copy anything Another way would be to modify ops that return PADTMPs not to return
http://perl5.git.perl.org/perl.git/commit/3455055faace06645b99a6ed63fce90144ab47e1
-- Father Chrysostomos |
Migrated from rt.perl.org#78194 (status was 'resolved')
Searchable as RT78194$
The text was updated successfully, but these errors were encountered: