From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sun, 30 Apr 2006 17:15:41 +0000 (+0000)
Subject: Even non moose classes get metaclassed for delegation
X-Git-Tag: 0_09_03~52
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4e848edbdb2b4faae182bfdfed11a24976ae3646;p=gitmo%2FMoose.git

Even non moose classes get metaclassed for delegation
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index f7a2252..81852e7 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -159,7 +159,7 @@ sub _guess_attr_class_or_role {
         unless $isa || $does;
 
     for (grep { blessed($_) } $isa, $does) {
-        confess "You must use classes/roles, not type constraints to use delegation"
+        confess "You must use classes/roles, not type constraints to use delegation ($_)"
             unless $_->isa( "Moose::Meta::Class" );
     }
     
@@ -171,6 +171,8 @@ sub _guess_attr_class_or_role {
         $_ = $_->meta if defined and !ref and $_->can("meta");
     }
 
+    $isa = Class::MOP::Class->initialize($isa) if $isa and !ref($isa);
+
     return $isa || $does;
 }
 
@@ -305,6 +307,25 @@ This will test if this class C<does> a given C<$role_name>. It will
 not only check it's local roles, but ask them as well in order to 
 cascade down the role hierarchy.
 
+=item B<add_attribute $attr_name, %params>
+
+This method does the same thing as L<Class::MOP::Class/add_attribute>, but adds
+suport for delegation.
+
+=back
+
+=head1 INTERNAL METHODS
+
+=over 4
+
+=item compute_delegation
+
+=item generate_delegation_list
+
+=item generate_delgate_method
+
+=item get_delegatable_methods
+
 =back
 
 =head1 BUGS
diff --git a/t/070_delegation.t b/t/070_delegation.t
index be15852..27adf0a 100644
--- a/t/070_delegation.t
+++ b/t/070_delegation.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 36;
+use Test::More tests => 35;
 use Test::Exception;
 
 {
@@ -130,15 +130,6 @@ use Test::Exception;
         );
     } "can delegate to non moose class using explicit method list";
 
-    ::dies_ok {
-        has child_f => (
-            isa     => "ChildF",
-            is      => "ro",
-            default => sub { ChildF->new },
-            handles => qr/.*/,
-        );
-    } "can't use regexes on foreign classes";
-
     my $delegate_class;
     ::lives_ok {
         has child_f => (
@@ -146,7 +137,7 @@ use Test::Exception;
             is      => "ro",
             default => sub { ChildF->new },
             handles => sub {
-                $delegate_class = $_[1];
+                $delegate_class = $_[1]->name;
             },
         );
     } "subrefs on non moose class give no meta";