From: Jonathan Rockway <jon@jrock.us>
Date: Tue, 11 Mar 2008 16:43:19 +0000 (+0000)
Subject: add support for roles => [] option to Moose::Meta::Create
X-Git-Tag: 0_55~288
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=61bdd94f8b2ac4af777256cb4024686269cd09d8;p=gitmo%2FMoose.git

add support for roles => [] option to Moose::Meta::Create
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 3dd0bb4..86ba9f8 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -31,6 +31,22 @@ sub initialize {
         @_);
 }
 
+sub create {
+    my ($self, $package_name, %options) = @_;
+    
+    (ref $options{roles} eq 'ARRAY')
+        || confess "You must pass an ARRAY ref of roles"
+            if exists $options{roles};
+    
+    my $class = $self->SUPER::create($package_name, %options);
+    
+    if(exists $options{roles} && defined $options{roles}){
+        Moose::Util::apply_all_roles($class, @{$options{roles}});
+    }
+    
+    return $class;
+}
+
 sub add_role {
     my ($self, $role) = @_;
     (blessed($role) && $role->isa('Moose::Meta::Role'))
@@ -435,6 +451,11 @@ to the L<Class::MOP::Class> documentation.
 
 =item B<initialize>
 
+=item B<create>
+
+Like C<< Class::MOP->create >> but accepts a list of roles to apply to
+the created class.
+
 =item B<make_immutable>
 
 Override original to add default options for inlining destructor
diff --git a/t/010_basics/013_create.t b/t/010_basics/013_create.t
new file mode 100644
index 0000000..84ddee6
--- /dev/null
+++ b/t/010_basics/013_create.t
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+use Test::More tests => 10;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose::Meta::Class');
+    use_ok('Moose');
+    use_ok('Moose::Role');
+}
+
+{ 
+    package Class;
+    use Moose;
+    
+    package Foo;
+    use Moose::Role;
+    sub foo_role_applied { 1 }
+    
+    package Conflicts::With::Foo;
+    use Moose::Role;
+    sub foo_role_applied { 0 }
+
+    package Not::A::Role;
+    sub lol_wut { 42 }
+}
+
+my $new_class;
+
+lives_ok {
+    $new_class = Moose::Meta::Class->create(
+        'Class::WithFoo',
+        superclasses => ['Class'],
+        roles        => ['Foo'],
+    );
+} 'creating lives';
+ok $new_class;
+
+my $with_foo = Class::WithFoo->new;
+
+ok $with_foo->foo_role_applied;
+isa_ok $with_foo, 'Class', '$with_foo';
+
+throws_ok {
+    Moose::Meta::Class->create(
+        'Made::Of::Fail',
+        superclasses => ['Class'],
+        roles => 'Foo', # "oops"
+    );
+} qr/You must pass an ARRAY ref of roles/;
+
+ok !Made::Of::Fail->isa('UNIVERSAL'), "did not create Made::Of::Fail";
+
+dies_ok {
+    Moose::Meta::Class->create(
+        'Continuing::To::Fail',
+        superclasses => ['Class'],
+        roles        => ['Foo', 'Conflicts::With::Foo'],
+    );
+} 'conflicting roles == death';
+
+# XXX: Continuing::To::Fail gets created anyway
+