From: Stevan Little <stevan.little@iinteractive.com>
Date: Sat, 16 Feb 2008 20:07:16 +0000 (+0000)
Subject: fixing delegation
X-Git-Tag: 0_55~303
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f4f3e701eaa9973098856eee76d199913b000a7e;p=gitmo%2FMoose.git

fixing delegation
---

diff --git a/Changes b/Changes
index 6f08950..e4fe4a2 100644
--- a/Changes
+++ b/Changes
@@ -4,7 +4,10 @@ Revision history for Perl extension Moose
     * Moose::Meta::Attribute 
       - fix handles so that it doesn't return nothing 
         when the method cannot be found, not sure why 
-        it ever did this originally 
+        it ever did this originally, this means we now
+        have slightly better support for AUTOLOADed 
+        objects
+        - added more delegation tests
 
 0.38 Fri. Feb. 15, 2008
     * Moose::Meta::Attribute 
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 7a635a2..835905a 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -439,11 +439,10 @@ sub install_accessors {
             else {
                 $associated_class->add_method($handle => subname $name, sub {
                     my $proxy = (shift)->$accessor();
-                    @_ = ($proxy, @_);
                     (defined $proxy) 
                         || confess "Cannot delegate $handle to $method_to_call because " . 
                                    "the value of " . $self->name . " is not defined";
-                    $proxy->$method_to_call;
+                    $proxy->$method_to_call(@_);
                 });
             }
         }
diff --git a/t/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t
index c9237cd..9e31583 100644
--- a/t/020_attributes/010_attribute_delegation.t
+++ b/t/020_attributes/010_attribute_delegation.t
@@ -3,13 +3,16 @@
 use strict;
 use warnings;
 
-use Test::More tests => 54;
+use Test::More tests => 58;
 use Test::Exception;
 
 BEGIN {  
     use_ok('Moose');               
 }
 
+# -------------------------------------------------------------------
+# HASH handles
+# -------------------------------------------------------------------
 # the canonical form of of the 'handles'
 # option is the hash ref mapping a 
 # method name to the delegated method name
@@ -41,6 +44,26 @@ is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');
 can_ok($bar, 'foo_bar');
 is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');
 
+# change the value ...
+
+$bar->foo->bar(30);
+
+# and make sure the delegation picks it up
+
+is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
+is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
+
+# change the value through the delegation ...
+
+$bar->foo_bar(50);
+
+# and make sure everyone sees it 
+
+is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
+is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
+
+# change the object we are delegating too
+
 my $foo = Foo->new(bar => 25);
 isa_ok($foo, 'Foo');
 
@@ -55,6 +78,9 @@ is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
 
+# -------------------------------------------------------------------
+# ARRAY handles 
+# -------------------------------------------------------------------
 # we also support an array based format
 # which assumes that the name is the same 
 # on either end
@@ -92,6 +118,9 @@ can_ok($car, 'stop');
 is($car->go, 'Engine::go', '... got the right value from ->go');
 is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
+# -------------------------------------------------------------------
+# REGEXP handles 
+# -------------------------------------------------------------------
 # and we support regexp delegation
 
 {
@@ -175,6 +204,10 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');    
 }
 
+# -------------------------------------------------------------------
+# ROLE handles
+# -------------------------------------------------------------------
+
 {
     package Foo::Bar;
     use Moose::Role;
@@ -214,8 +247,3 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');        
 }
 
-
-
-
-
-
diff --git a/t/020_attributes/011_more_attr_delegation.t b/t/020_attributes/011_more_attr_delegation.t
index 4445908..f331a05 100644
--- a/t/020_attributes/011_more_attr_delegation.t
+++ b/t/020_attributes/011_more_attr_delegation.t
@@ -6,6 +6,14 @@ use warnings;
 use Test::More tests => 39;
 use Test::Exception;
 
+=pod
+
+This tests the more complex 
+delegation cases and that they 
+do not fail at compile time.
+
+=cut
+
 {
 
     package ChildASuper;