work around a segfault

diff --git a/Changes b/Changes
index 7c56059..bcca507 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension Class-MOP.
 
+    * Class::MOP
+      - MOP.xs does sanity checks on the coderef to avoid a segfault
+
 0.59
 
     * Class::MOP::Class

diff --git a/MOP.xs b/MOP.xs
index 53724ff..461e46e 100644 (file)
--- a/MOP.xs
+++ b/MOP.xs
@@ -24,8 +24,17 @@ get_code_info(coderef)
   PPCODE:
     if( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV){
       coderef = SvRV(coderef);
-      name    = GvNAME( CvGV(coderef) );
-      pkg     = HvNAME( GvSTASH(CvGV(coderef)) );
+      /* I think this only gets triggered with a mangled coderef, but if
+         we hit it without the guard, we segfault. The slightly odd return
+         value strikes me as an improvement (mst)
+      */
+      if (isGV_with_GP(CvGV(coderef))) {
+        pkg     = HvNAME( GvSTASH(CvGV(coderef)) );
+        name    = GvNAME( CvGV(coderef) );
+      } else {
+        pkg     = "__UNKNOWN__";
+        name    = "__ANON__";
+      }
 
       EXTEND(SP, 2);
       PUSHs(newSVpvn(pkg, strlen(pkg)));