making handles and AUTOLOAD play a bit better

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 8a64497..6c48b60 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -164,7 +164,7 @@ use Moose::Util ();
         make_immutable => sub {
             my $class = $CALLER;
             return subname 'Moose::make_immutable' => sub {
-                $class->meta->make_immutable(@_)
+                $class->meta->make_immutable(@_);
             };            
         },        
         confess => sub {

diff --git a/t/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t
index 9e31583..2e6e585 100644 (file)
--- 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 => 58;
+use Test::More tests => 85;
 use Test::Exception;
 
 BEGIN {  
@@ -247,3 +247,145 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');        
 }
 
+# -------------------------------------------------------------------
+# AUTOLOAD & handles
+# -------------------------------------------------------------------
+
+{
+    package Foo::Autoloaded;
+    use Moose;
+
+    sub AUTOLOAD {
+        my $self = shift;
+
+        my $name = our $AUTOLOAD;
+        $name =~ s/.*://;              # strip fully-qualified portion
+
+        if (@_) {
+            return $self->{$name} = shift;
+        } else {
+            return $self->{$name};
+        }
+    }
+
+    package Bar::Autoloaded;
+    use Moose; 
+    
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo::Autoloaded->new },
+        handles => { 'foo_bar' => 'bar' }
+    );
+    
+    package Baz::Autoloaded;
+    use Moose; 
+    
+    has 'foo' => (
+        is      => 'rw',
+        default => sub { Foo::Autoloaded->new },
+        handles => ['bar']
+    );    
+    
+    package Goorch::Autoloaded;
+    use Moose; 
+    
+    ::dies_ok {
+        has 'foo' => (
+            is      => 'rw',
+            default => sub { Foo::Autoloaded->new },
+            handles => qr/bar/
+        );    
+    } '... you cannot delegate to AUTOLOADED class with regexp';
+}
+
+# check HASH based delegation w/ AUTOLOAD
+
+{
+    my $bar = Bar::Autoloaded->new;
+    isa_ok($bar, 'Bar::Autoloaded');
+
+    ok($bar->foo, '... we have something in bar->foo');
+    isa_ok($bar->foo, 'Foo::Autoloaded');
+
+    # 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::Autoloaded->new;
+    isa_ok($foo, 'Foo::Autoloaded');
+
+    $foo->bar(25);
+    
+    is($foo->bar, 25, '... got the right foo->bar');
+
+    lives_ok {
+        $bar->foo($foo);
+    } '... assigned the new Foo to Bar->foo';
+
+    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');
+}
+
+# check ARRAY based delegation w/ AUTOLOAD
+
+{
+    my $baz = Baz::Autoloaded->new;
+    isa_ok($baz, 'Baz::Autoloaded');
+
+    ok($baz->foo, '... we have something in baz->foo');
+    isa_ok($baz->foo, 'Foo::Autoloaded');
+
+    # change the value ...
+
+    $baz->foo->bar(30);
+
+    # and make sure the delegation picks it up
+
+    is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value');
+    is($baz->bar, 30, '... baz->foo_bar delegated correctly');
+
+    # change the value through the delegation ...
+
+    $baz->bar(50);
+
+    # and make sure everyone sees it 
+
+    is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value');
+    is($baz->bar, 50, '... baz->foo_bar delegated correctly');
+
+    # change the object we are delegating too
+
+    my $foo = Foo::Autoloaded->new;
+    isa_ok($foo, 'Foo::Autoloaded');
+
+    $foo->bar(25);
+    
+    is($foo->bar, 25, '... got the right foo->bar');
+
+    lives_ok {
+        $baz->foo($foo);
+    } '... assigned the new Foo to Baz->foo';
+
+    is($baz->foo, $foo, '... assigned baz->foo with the new Foo');
+
+    is($baz->foo->bar, 25, '... baz->foo->bar returned the right result');
+    is($baz->bar, 25, '... and baz->foo_bar delegated correctly again');
+}