From: Chris Prather <chris@prather.org>
Date: Sat, 29 Aug 2009 02:39:59 +0000 (-0400)
Subject: unwrap Wrapped methods when checking for overriding things
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ef7fec3f8233b633bd62b28d80377aeabb3317a;p=gitmo%2FMoose.git

unwrap Wrapped methods when checking for overriding things
---

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 42b0e2d..ac348be 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -582,17 +582,29 @@ sub _check_associated_methods {
     }
 }
 
+sub _looks_like_overwriting_local_method {
+	my ($self, $accessor) = @_;
+	my $method = $self->associated_class->get_method($accessor);
+	return 0 unless $method;
+	
+	# get ourselves down to the original method
+	while ($method->isa('Class::MOP::Method::Wrapped')) {
+		$method = $method->get_original_method;
+	}
+	return 1 if !$method->isa('Class::MOP::Method::Accessor');
+	return 0 if !$self->definition_context;
+	return 0 if $method->package_name ne $self->definition_context->{package};
+	return 0;
+}
+
 sub _process_accessors {
     my $self = shift;
     my ($type, $accessor, $generate_as_inline_methods) = @_;
     $accessor = (keys %$accessor)[0] if (ref($accessor)||'') eq 'HASH';
-    my $method = $self->associated_class->get_method($accessor);
-    if ($method && !$method->isa('Class::MOP::Method::Accessor')
-     && (!$self->definition_context
-      || $method->package_name eq $self->definition_context->{package})) {
+	if ($self->_looks_like_overwriting_local_method($accessor)) {
         Carp::cluck(
             "You are overwriting a locally defined method ($accessor) with "
-          . "an accessor"
+          . "an accessor at line " .$self->definition_context->{line}
         );
     }
     $self->SUPER::_process_accessors(@_);