summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ext/B/B.pm25
-rw-r--r--ext/B/B.xs42
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