view release on metacpan or  search on metacpan

lib/Devel/PatchPerl/Plugin/Asan.pm  view on Meta::CPAN

+    sv_catpvs(gvname, "::__ANON__");
     anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
     SvREFCNT_dec(gvname);
 
END

  #; )
  _patch($patch);
  _add_patchlevel($vers, "RT#91678 S_anonymise_cv_maybe UTF8 cleanup");
}

sub _patch_cvgv_lexsub
{
  my $vers = shift;
  my $patch = <<'END';
From 5e135b6d655cf605ed3d659b94eef847e7d5d29c Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Thu, 11 Jul 2013 12:09:15 -0500
Subject: [PATCH] [perl #118525] Return B::HEK for B::CV::GV of lexical subs

A lexsub has a hek instead of a gv.
Provide a ref to a PV for the name in the new B::HEK class.
This crashed previously accessing the not existing SvFLAGS of the hek.
---
 ext/B/B.pm    |   27 ++++++++++++++++++++++++++-
 ext/B/B.xs    |   42 +++++++++++++++++++++++++++++++++++++++++-
 ext/B/typemap |   12 ++++++++++++
 3 files changed, 79 insertions(+), 2 deletions(-)

diff ext/B/B.pm~ ext/B/B.pm
index 8b13dea..c153899 100644
--- ext/B/B.pm~
+++ ext/B/B.pm
@@ -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 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);