Skip to content

Commit

Permalink
CvGV is no longer a simple struct member access
Browse files Browse the repository at this point in the history
The same slot is also used for the NAME_HEK for lexical subs, so:

- split B::CV::GV out into its own function that uses the CvGV macro

- add B::CV::NAME_HEK so the name of a lexical sub can be fetched
  • Loading branch information
tonycoz authored and rjbs committed Jul 30, 2013
1 parent a183b35 commit e6c4c33
Show file tree
Hide file tree
Showing 3 changed files with 65 additions and 2 deletions.
6 changes: 5 additions & 1 deletion ext/B/B.pm
Expand Up @@ -15,7 +15,7 @@ require Exporter;
# walkoptree comes from B.xs

BEGIN {
$B::VERSION = '1.42';
$B::VERSION = '1.42_01';
@B::EXPORT_OK = ();

# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
Expand Down Expand Up @@ -1014,6 +1014,10 @@ For constant subroutines, returns the constant SV returned by the subroutine.
=item const_sv
=item NAME_HEK
Returns the name of a lexical sub, otherwise C<undef>.
=back
=head2 B::HV Methods
Expand Down
22 changes: 21 additions & 1 deletion ext/B/B.xs
Expand Up @@ -1380,7 +1380,6 @@ IVX(sv)
B::IO::IoFLAGS = PVIO_flags_ix
B::AV::MAX = PVAV_max_ix
B::CV::STASH = PVCV_stash_ix
B::CV::GV = PVCV_gv_ix
B::CV::FILE = PVCV_file_ix
B::CV::OUTSIDE = PVCV_outside_ix
B::CV::OUTSIDE_SEQ = PVCV_outside_seq_ix
Expand Down Expand Up @@ -1873,6 +1872,27 @@ const_sv(cv)
PPCODE:
PUSHs(make_sv_object(aTHX_ (SV *)cv_const_sv(cv)));

void
GV(cv)
B::CV cv
PREINIT:
GV *gv;
CODE:
gv = CvGV(cv);
ST(0) = gv ? make_sv_object((SV*)gv) : &PL_sv_undef;

#if PERL_VERSION > 17

SV *
NAME_HEK(cv)
B::CV cv
CODE:
RETVAL = CvNAMED(cv) ? newSVhek(CvNAME_HEK(cv)) : &PL_sv_undef;
OUTPUT:
RETVAL

#endif

MODULE = B PACKAGE = B::HV PREFIX = Hv

STRLEN
Expand Down
39 changes: 39 additions & 0 deletions ext/B/t/b.t
Expand Up @@ -376,4 +376,43 @@ SKIP: {
is($op->name, "leavesub", "overlay: orig name");
}

{ # [perl #118525]
{
sub foo {}
my $cv = B::svref_2object(\&foo);
ok($cv, "make a B::CV from a non-anon sub reference");
isa_ok($cv, "B::CV");
my $gv = $cv->GV;
ok($gv, "we get a GV from a GV on a normal sub");
isa_ok($gv, "B::GV");
is($gv->NAME, "foo", "check the GV name");
SKIP:
{ # do we need these version checks?
skip "no HEK before 5.18", 1 if $] < 5.018;
is($cv->NAME_HEK, undef, "no hek for a global sub");
}
}

SKIP:
{
skip "no HEK before 5.18", 4 if $] < 5.018;
eval <<'EOS'
{
use feature 'lexical_subs';
no warnings 'experimental::lexical_subs';
my sub bar {};
my $cv = B::svref_2object(\&bar);
ok($cv, "make a B::CV from a lexical sub reference");
isa_ok($cv, "B::CV");
my $gv = $cv->GV;
is($gv, undef, "GV on a lexical sub is NULL");
my $hek = $cv->NAME_HEK;
is($hek, "bar", "check the NAME_HEK");
}
1;
EOS
or die "lexical_subs test failed to compile: $@";
}
}

done_testing();

0 comments on commit e6c4c33

Please sign in to comment.