# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.44';
+ $B::VERSION = '1.45';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
=item const_sv
+=item NAME_HEK
+
+Returns the name of a lexical sub, otherwise C<undef>.
+
=back
=head2 B::HV Methods
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
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
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();