From 0bb2719fa5adbf1429c47d20b34262afac85376e Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Wed, 13 Apr 2016 04:26:20 -0400
Subject: [PATCH] fix method cache generation when package contains blessed
 subs

When generating the method cache, the code was trying to call ->body on
it if it was an object.  The add_method code had previously been fixed
to only call ->body on meta objects rather than anything blessed.  The
XS code was only checking for objects being making that call.  This was
masked by method cache being kept up to date.

If the method cache is out of date though, this can crash.  The cache
can be intentionally reset, or we may not be able to track its status
properly (perl 5.8 without Class::C3::XS).

Fixes RT#113704
---
 Changes          | 5 +++++
 t/cmop/methods.t | 6 ++++++
 xs/HasMethods.xs | 2 +-
 3 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/Changes b/Changes
index f8a00be47..ca811f3a9 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,11 @@ for, noteworthy changes.
 
 {{$NEXT}}
 
+  [BUG FIXES]
+
+  - Fixed method cache regeneration when a class contains a blessed sub
+    (RT#113704)
+
   [TESTS]
 
   - restore test on perl 5.8.x when Class::C3::XS is not installed (RT#113704)
diff --git a/t/cmop/methods.t b/t/cmop/methods.t
index a7a5d46e6..294c8a4d7 100644
--- a/t/cmop/methods.t
+++ b/t/cmop/methods.t
@@ -101,6 +101,12 @@ is( exception {
   $Foo->add_method('bork', $bork_blessed);
 }, undef, 'can add blessed sub as method');
 
+$Foo->reset_package_cache_flag;
+
+is( exception {
+  $Foo->has_method('bork');
+}, undef, 'regeneration of method cache works after adding blessed sub as method');
+
 # now check all our other items ...
 
 ok( $Foo->has_method('FOO_CONSTANT'),
diff --git a/xs/HasMethods.xs b/xs/HasMethods.xs
index e136abece..acd39383d 100644
--- a/xs/HasMethods.xs
+++ b/xs/HasMethods.xs
@@ -24,7 +24,7 @@ mop_update_method_map(pTHX_ HV *const stash, HV *const map)
             continue;
         }
 
-        if (sv_isobject(method)) {
+        if (sv_derived_from(method, "Class::MOP::Method")) {
             /* $method_object->body() */
             body = mop_call0(aTHX_ method, KEY_FOR(body));
         }