fix clobberage of runtime-installed wrappers by Sub::Defer

diff --git a/Changes b/Changes
index f825bfb..87e81f1 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - Fix clobberage of runtime-installed wrappers by Sub::Defer
   - Fix nonMoo constructor firing through multiple layers of Moo
   - Fix bug where nonMoo is mistakenly detected given a Moo superclass
     with no attributes (and hence no own constructor)

diff --git a/lib/Sub/Defer.pm b/lib/Sub/Defer.pm
index 4f2db1f..8202687 100644 (file)
--- a/lib/Sub/Defer.pm
+++ b/lib/Sub/Defer.pm
@@ -14,11 +14,14 @@ sub undefer_sub {
     $DEFERRED{$deferred}||return $deferred
   };
   ${$undeferred_ref} = my $made = $maker->();
-  if (defined($target)) {
+
+  # make sure the method slot has not changed since deferral time
+  if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') {
     no warnings 'redefine';
     *{_getglob($target)} = $made;
   }
   push @{$DEFERRED{$made} = $DEFERRED{$deferred}}, $made;
+
   return $made;
 }
 

diff --git a/t/sub-defer.t b/t/sub-defer.t
index a5309b0..ba7f042 100644 (file)
--- a/t/sub-defer.t
+++ b/t/sub-defer.t
@@ -39,4 +39,19 @@ my $three = sub { 'three' };
 
 is(undefer_sub($three), $three, 'undefer non-deferred is a no-op');
 
+my $four_defer = defer_sub 'Foo::four' => sub {
+  sub { 'four' }
+};
+is($four_defer, \&Foo::four, 'four defer installed');
+
+# somebody somewhere wraps up around the deferred installer
+no warnings qw/redefine/;
+my $orig = Foo->can('four');
+*Foo::four = sub {
+  $orig->() . ' with a twist';
+};
+
+is(Foo->four, 'four with a twist', 'around works');
+is(Foo->four, 'four with a twist', 'around has not been destroyed by first invocation');
+
 done_testing;