From: Dave Rolsky <autarch@urth.org>
Date: Tue, 26 Oct 2010 22:07:08 +0000 (-0500)
Subject: Warn when an accessor for one attr overwrites another attr's accessor.
X-Git-Tag: 1.18~26
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7dfe605d8f0ce4373a89a12d2849fad8ed051c1;p=gitmo%2FMoose.git

Warn when an accessor for one attr overwrites another attr's accessor.
---

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 5fe5e77..7273208 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -648,6 +648,18 @@ sub _process_accessors {
     $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')
+        && $method->associated_attribute->name ne $self->name ) {
+
+        my $other_attr_name = $method->associated_attribute->name;
+        my $name            = $self->name;
+
+        Carp::cluck(
+            "You are overwriting an accessor ($accessor) for the $other_attr_name attribute"
+                . " with a new accessor method for the $name attribute" );
+    }
+
     if (
            $method
         && !$method->isa('Class::MOP::Method::Accessor')
@@ -659,6 +671,7 @@ sub _process_accessors {
             "You are overwriting a locally defined method ($accessor) with "
                 . "an accessor" );
     }
+
     if (  !$self->associated_class->has_method($accessor)
         && $self->associated_class->has_package_symbol( '&' . $accessor ) ) {
 
diff --git a/t/020_attributes/039_accessor_overwrite_warning.t b/t/020_attributes/039_accessor_overwrite_warning.t
new file mode 100644
index 0000000..d7275a8
--- /dev/null
+++ b/t/020_attributes/039_accessor_overwrite_warning.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Test::Requires {
+    'Test::Output' => '0.01',
+};
+
+{
+    package Bar;
+    use Moose;
+
+    has has_attr => (
+        is => 'ro',
+    );
+
+    ::stderr_like{ has attr => (
+            is        => 'ro',
+            predicate => 'has_attr',
+        )
+        }
+        qr/\QYou are overwriting an accessor (has_attr) for the has_attr attribute with a new accessor method for the attr attribute/,
+        'overwriting an accessor for another attribute causes a warning';
+}
+
+done_testing;