From: Tomas Doran <bobtfish@bobtfish.net>
Date: Wed, 26 Nov 2008 14:43:31 +0000 (+0000)
Subject: Make removing attributes also remove their installed delegators + test
X-Git-Tag: 0.62~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e1d6f0a3c8cee0350b97695a2307af7004a1eb97;p=gitmo%2FMoose.git

Make removing attributes also remove their installed delegators + test
---

diff --git a/Changes b/Changes
index 109ca84..0e5b1b9 100644
--- a/Changes
+++ b/Changes
@@ -19,6 +19,10 @@ Revision history for Perl extension Moose
       - Remove the make_immutable keyword, which has been
         deprecated since April. It breaks metaclasses that
         use Moose without no Moose (Sartak)
+    * Moose::Meta::Attribute
+      - Removing an attribute from a class now also removes delegation
+        (handles) methods installed for that attribute (t0m)
+        - added test for this (t0m)
     * Moose::Meta::Role
       - create method for constructing a role
         dynamically (Sartak)
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 0b236ac..f2272ac 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -567,6 +567,13 @@ sub install_accessors {
     return;
 }
 
+sub remove_accessors {
+    my $self = shift;
+    $self->SUPER::remove_accessors(@_);
+    $self->remove_delegation if $self->has_handles;
+    return;
+}
+
 sub install_delegation {
     my $self = shift;
 
@@ -604,6 +611,15 @@ sub install_delegation {
     }    
 }
 
+sub remove_delegation {
+    my $self = shift;
+    my %handles = $self->_canonicalize_handles;
+    my $associated_class = $self->associated_class;
+    foreach my $handle (keys %handles) {
+        $self->associated_class->remove_method($handle);
+    }
+}
+
 # private methods to help delegation ...
 
 sub _canonicalize_handles {
@@ -745,8 +761,12 @@ will behave just as L<Class::MOP::Attribute> does.
 
 =item B<install_accessors>
 
+=item B<remove_accessors>
+
 =item B<install_delegation>
 
+=item B<remove_delegation>
+
 =item B<accessor_metaclass>
 
 =item B<get_value>
diff --git a/t/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t
index ed75c6f..a792dc9 100644
--- a/t/020_attributes/010_attribute_delegation.t
+++ b/t/020_attributes/010_attribute_delegation.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 86;
+use Test::More tests => 88;
 use Test::Exception;
 
 
@@ -392,3 +392,21 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     is($baz->foo->bar, 25, '... baz->foo->bar returned the right result');
     is($baz->bar, 25, '... and baz->foo_bar delegated correctly again');
 }
+
+# Check that removing attributes removes their handles methods also.
+{
+    {
+        package Quux;
+        use Moose;
+        has foo => ( 
+            isa => 'Foo', 
+            default => sub { Foo->new },
+            handles => { 'foo_bar' => 'bar' }
+        );
+    }
+    my $i = Quux->new;
+    ok($i->meta->has_method('foo_bar'), 'handles method foo_bar is present');
+    $i->meta->remove_attribute('foo');
+    ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed');
+}
+