In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3a23d767cf63fb2e8de3d79eadee49bbc33eec53?hp=1da7b04307a09e4931d85cc5a89e85f653429783>
- Log ----------------------------------------------------------------- commit 3a23d767cf63fb2e8de3d79eadee49bbc33eec53 Author: David Mitchell <[email protected]> Date: Fri Sep 19 16:07:08 2014 +0100 fix B::PADOP->sv and ->gv PADOP structs, which are only used on threaded builds, have an op_padix field rather than an op_sv or op_gv. The B::PADOP sv and gv methods would do PL_curpad[o->op_padix] to look up the value, That is completely wrong. PL_curpad is the pad of the caller of B::PADOP::sv/gv, not the pad of the sub containing the PADOP op. This fault appears to to go back to 1999, when PADOP was first added. It's probably never been spotted because: a) PADOP only ever used for creating GV ops on threaded builds (so ->sv is probably never called), b) it has a check where if the thing it retrieved from the pad isn't a GV, it returns NULL instead. Fix this by always returning NULL. This is comparable with B::SVOP_>sv, which always returns op_sv, which on threaded builds always happens to be NULL. Note that B::SVOP->sv expects the caller to retrieve op_targ and do the pad lookup. NB just to avoid confusion (I was certainly confused), these ops are implemented with the types shown: unthreaded: const: B::SVOP gvsv: B::SVOP threaded: const: B::SVOP gvsv: B::PADOP ----------------------------------------------------------------------- Summary of changes: ext/B/B.xs | 23 +++++++++-------------- ext/B/t/b.t | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+), 14 deletions(-) diff --git a/ext/B/B.xs b/ext/B/B.xs index a130ad3..b048f80 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1159,20 +1159,15 @@ next(o) } } break; - case 39: /* sv */ - case 40: /* gv */ - /* It happens that the output typemaps for B::SV and B::GV - * are identical. The "smarts" are in make_sv_object(), - * which determines which class to use based on SvTYPE(), - * rather than anything baked in at compile time. */ - if (cPADOPo->op_padix) { - ret = PAD_SVl(cPADOPo->op_padix); - if (ix == 40 && SvTYPE(ret) != SVt_PVGV) - ret = NULL; - } else { - ret = NULL; - } - ret = make_sv_object(aTHX_ ret); + case 39: /* B::PADOP::sv */ + case 40: /* B::PADOP::gv */ + /* PADOPs should only be created on threaded builds. + * They don't have an sv or gv field, just an op_padix + * field. Leave it to the caller to retrieve padix + * and look up th value in the pad. Don't do it here, + * becuase PL_curpad is the pad of the caller, not the + * pad of the sub the op is part of */ + ret = make_sv_object(aTHX_ NULL); break; case 41: /* pv */ /* OP_TRANS uses op_pv to point to a table of 256 or >=258 diff --git a/ext/B/t/b.t b/ext/B/t/b.t index 9933978..271eb37 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -443,4 +443,42 @@ SKIP: { } +# make sure ->sv, -gv methods do the right thing on threaded builds +{ + + # for some reason B::walkoptree only likes a sub name, not a code ref + my ($gv, $sv); + sub gvsv_const { + # make the early pad slots something unlike a threaded const or + # gvsv + my ($dummy1, $dummy2, $dummy3, $dummy4) = qw(foo1 foo2 foo3 foo4); + my $self = shift; + if ($self->name eq 'gvsv') { + $gv = $self->gv; + } + elsif ($self->name eq 'const') { + $sv = $self->sv; + } + }; + + B::walkoptree(B::svref_2object(sub {our $x = 1})->ROOT, "::gvsv_const"); + ok(defined $gv, "gvsv->gv seen"); + ok(defined $sv, "const->sv seen"); + if ($Config::Config{useithreads}) { + # should get NULLs + is(ref($gv), "B::SPECIAL", "gvsv->gv is special"); + is(ref($sv), "B::SPECIAL", "const->sv is special"); + is($$gv, 0, "gvsv->gv special is 0 (NULL)"); + is($$sv, 0, "const->sv special is 0 (NULL)"); + } + else { + is(ref($gv), "B::GV", "gvsv->gv is GV"); + is(ref($sv), "B::IV", "const->sv is IV"); + pass(); + pass(); + } + +} + + done_testing(); -- Perl5 Master Repository
