diff options
-rw-r--r-- | ext/B/B.pm | 25 | ||||
-rw-r--r-- | ext/B/B.xs | 42 |
2 files changed, 66 insertions, 1 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index 8b13dea589..85c0bfeef3 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -1244,6 +1244,8 @@ Since perl 5.17.1 Perl 5.18 introduces a new class, B::PADLIST, returned by B::CV's C<PADLIST> method. +Perl 5.18.1 and 5.19 introduce a new class, B::HEK, returned by B::CV's +C<GV> method for lexical subs. =head2 B::PADLIST Methods @@ -1265,6 +1267,29 @@ rather than a list of all of them. =back +=head2 B::HEK Methods + +A B::HEK is returned by B::CV->GV for a lexical sub, defining its name. +Using the dereferenced scalar value of the object returns the string value, +which is usually enough; the other methods are rarely needed. + + use B; + use feature 'lexical_subs'; + my sub p {1}; + $cv = B::svref_2object(\&p); + $hek = $cv->GV; + print $$hek, "==", $hek->KEY; + +=over 4 + +=item KEY + +=item LEN + +=item FLAGS + +=back + =head2 $B::overlay Although the optree is read-only, there is an overlay facility that allows diff --git a/ext/B/B.xs b/ext/B/B.xs index fbe6be6719..444d2fe3c9 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -296,6 +296,17 @@ make_sv_object(pTHX_ SV *sv) } static SV * +make_hek_object(pTHX_ HEK *hek) +{ + SV *ret = sv_setref_pvn(sv_newmortal(), "B::HEK", HEK_KEY(hek), HEK_LEN(hek)); + SV *rv = SvRV(ret); + SvIOKp_on(rv); + SvIV_set(rv, PTR2IV(hek)); + SvREADONLY_on(rv); + return ret; +} + +static SV * make_temp_object(pTHX_ SV *temp) { SV *target; @@ -602,6 +613,7 @@ typedef IO *B__IO; typedef MAGIC *B__MAGIC; typedef HE *B__HE; +typedef HEK *B__HEK; typedef struct refcounted_he *B__RHE; #ifdef PadlistARRAY typedef PADLIST *B__PADLIST; @@ -1390,7 +1402,10 @@ IVX(sv) ptr = (ix & 0xFFFF) + (char *)SvANY(sv); switch ((U8)(ix >> 16)) { case (U8)(sv_SVp >> 16): - ret = make_sv_object(aTHX_ *((SV **)ptr)); + if ((ix == (PVCV_gv_ix)) && CvNAMED(sv)) + ret = make_hek_object(aTHX_ CvNAME_HEK((CV*)sv)); + else + ret = make_sv_object(aTHX_ *((SV **)ptr)); break; case (U8)(sv_IVp >> 16): ret = sv_2mortal(newSViv(*((IV *)ptr))); @@ -1588,6 +1603,31 @@ PV(sv) } ST(0) = newSVpvn_flags(p, len, SVs_TEMP | utf8); +MODULE = B PACKAGE = B::HEK + +void +KEY(hek) + B::HEK hek + ALIAS: + LEN = 1 + FLAGS = 2 + PPCODE: + SV *pv; + switch (ix) { + case 0: + pv = newSVpvn(HEK_KEY(hek), HEK_LEN(hek)); + if (HEK_UTF8(hek)) SvUTF8_on(pv); + SvREADONLY_on(pv); + PUSHs(pv); + break; + case 1: + mPUSHu(HEK_LEN(hek)); + break; + case 2: + mPUSHu(HEK_FLAGS(hek)); + break; + } + MODULE = B PACKAGE = B::PVMG void |