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 )