App-perlall
view release on metacpan or search on metacpan
lib/Devel/PatchPerl/Plugin/Asan.pm view on Meta::CPAN
+
+=back
+
=head2 $B::overlay
Although the optree is read-only, there is an overlay facility that allows
diff ext/B/B.xs~ ext/B/B.xs
index fbe6be6..444d2fe 100644
--- ext/B/B.xs~
+++ 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
diff ext/B/typemap~ ext/B/typemap
index e97fb76..88de4da 100644
--- ext/B/typemap~
+++ ext/B/typemap
@@ -35,6 +35,7 @@ PADOFFSET T_UV
B::HE T_HE_OBJ
B::RHE T_RHE_OBJ
+B::HEK T_HEK_OBJ
B::PADLIST T_PL_OBJ
@@ -79,6 +80,14 @@ T_RHE_OBJ
else
croak(\"$var is not a reference\")
+T_HEK_OBJ
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ croak(\"$var is not a reference\")
+
T_PL_OBJ
if (SvROK($arg)) {
IV tmp = SvIV((SV*)SvRV($arg));
@@ -94,6 +103,9 @@ T_MG_OBJ
T_HE_OBJ
sv_setiv(newSVrv($arg, "B::HE"), PTR2IV($var));
+T_HEK_OBJ
+ sv_setiv(newSVrv($arg, "B::HEK"), PTR2IV($var));
+
T_RHE_OBJ
sv_setiv(newSVrv($arg, "B::RHE"), PTR2IV($var));
--
1.7.10.4
END
( run in 1.183 second using v1.01-cache-2.11-cpan-71847e10f99 )