From: Shawn M Moore <sartak@gmail.com>
Date: Tue, 28 Apr 2009 10:08:44 +0000 (-0400)
Subject: Handle overriding and wrapping in the same class
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e842cd1d0cc4efc62926318b4ed87e851635490d;p=gitmo%2FPerl-Critic-Dynamic-Moose.git

Handle overriding and wrapping in the same class
---

diff --git a/lib/Perl/Critic/Policy/DynamicMoose/RequireMethodModifiers.pm b/lib/Perl/Critic/Policy/DynamicMoose/RequireMethodModifiers.pm
index 561b5c8..7580470 100644
--- a/lib/Perl/Critic/Policy/DynamicMoose/RequireMethodModifiers.pm
+++ b/lib/Perl/Critic/Policy/DynamicMoose/RequireMethodModifiers.pm
@@ -19,11 +19,18 @@ sub violates_metaclass {
     for my $name (keys %$map) {
         my $method = $map->{$name};
 
-        # Modifiers are always fine.
-        next if $method->isa('Class::MOP::Method::Wrapped')
-             || $method->isa('Moose::Meta::Method::Overridden')
+        # override and augment modifiers are always fine.
+        next if $method->isa('Moose::Meta::Method::Overridden')
              || $method->isa('Moose::Meta::Method::Augmented');
 
+        # Since we can implicitly override and wrap in the same class, we
+        # need to be a little more careful here.
+        if ($method->isa('Class::MOP::Method::Wrapped')) {
+            my $orig_method = $method->get_original_method;
+            next if $method->associated_metaclass->name
+                 ne $orig_method->associated_metaclass->name;
+        }
+
         # Generated methods
         next if $method->isa('Class::MOP::Method::Generated');
 
diff --git a/t/DynamicMoose/RequireMethodModifiers.run b/t/DynamicMoose/RequireMethodModifiers.run
index 78eed8b..5b59485 100644
--- a/t/DynamicMoose/RequireMethodModifiers.run
+++ b/t/DynamicMoose/RequireMethodModifiers.run
@@ -170,3 +170,87 @@ extends 'Parent';
 
 after foo => sub {};
 
+#-----------------------------------------------------------------------------
+
+## name Pull in a method from a role. Could go either way here.
+## failures 1
+## cut
+
+package Parent;
+use Moose;
+
+sub foo {}
+
+package Role;
+use Moose::Role;
+
+sub foo {}
+
+package Child;
+use Moose;
+extends 'Parent';
+with 'Role';
+
+#-----------------------------------------------------------------------------
+
+## name Grandparent
+## failures 1
+## cut
+
+package Grandparent;
+use Moose;
+
+sub foo {}
+
+package Parent;
+use Moose;
+extends 'Grandparent';
+
+sub bar {}
+
+package Child;
+use Moose;
+extends 'Parent';
+
+sub foo {}
+
+#-----------------------------------------------------------------------------
+
+## name Grandparent with modifiers
+## failures 0
+## cut
+
+package Grandparent;
+use Moose;
+
+sub foo {}
+
+package Parent;
+use Moose;
+extends 'Grandparent';
+
+before foo => sub {};
+
+package Child;
+use Moose;
+extends 'Parent';
+
+after foo => sub {};
+
+#-----------------------------------------------------------------------------
+
+## name Wrapping an implicit override
+## failures 1
+## cut
+
+package Parent;
+use Moose;
+
+sub foo {}
+
+package Child;
+use Moose;
+extends 'Parent';
+
+before foo => sub {};
+sub foo {}