Make sure roles are applied to right metaclass
Dave Rolsky [Sun, 13 Feb 2011 23:50:23 +0000 (17:50 -0600)]
lib/MooseX/ClassAttribute/Trait/Application/ToClass.pm
lib/MooseX/ClassAttribute/Trait/Application/ToRole.pm
t/06-role.t

index 423de0f..12a9f29 100644 (file)
@@ -8,7 +8,8 @@ use Moose::Role;
 
 with 'MooseX::ClassAttribute::Trait::Application';
 
-sub _apply_class_attributes {
+around apply => sub {
+    my $orig = shift;
     my $self  = shift;
     my $role  = shift;
     my $class = shift;
@@ -20,6 +21,14 @@ sub _apply_class_attributes {
         },
     );
 
+    $self->$orig( $role, $class );
+};
+
+sub _apply_class_attributes {
+    my $self  = shift;
+    my $role  = shift;
+    my $class = shift;
+
     my $attr_metaclass = $class->attribute_metaclass();
 
     foreach my $attribute_name ( $role->get_class_attribute_list() ) {
index 52a6047..babdbff 100644 (file)
@@ -11,7 +11,8 @@ use Moose::Role;
 
 with 'MooseX::ClassAttribute::Trait::Application';
 
-sub _apply_class_attributes {
+around apply => sub {
+    my $orig  = shift;
     my $self  = shift;
     my $role1 = shift;
     my $role2 = shift;
@@ -27,6 +28,14 @@ sub _apply_class_attributes {
         },
     );
 
+    $self->$orig( $role1, $role2 );
+};
+
+sub _apply_class_attributes {
+    my $self  = shift;
+    my $role1 = shift;
+    my $role2 = shift;
+
     foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
         if (   $role2->has_class_attribute($attribute_name)
             && $role2->get_class_attribute($attribute_name)
index fb1cbb5..43ca560 100644 (file)
@@ -45,9 +45,8 @@ use Moose::Util qw( apply_all_roles );
     }
 }
 
-is_deeply(
-    [ map { $_->name() } ClassWithRoleHCA->meta()->calculate_all_roles() ],
-    ['RoleHCA'],
+ok(
+    ClassWithRoleHCA->meta()->does_role('RoleHCA'),
     'ClassWithRoleHCA does RoleHCA'
 );
 
@@ -55,9 +54,8 @@ SharedTests::run_tests('ClassWithRoleHCA');
 
 ClassWithRoleHCA->meta()->make_immutable();
 
-is_deeply(
-    [ map { $_->name() } ClassWithRoleHCA->meta()->calculate_all_roles() ],
-    ['RoleHCA'],
+ok(
+    ClassWithRoleHCA->meta()->does_role('RoleHCA'),
     'ClassWithRoleHCA (immutable) does RoleHCA'
 );
 
@@ -73,6 +71,11 @@ is_deeply(
     with 'RoleHCA';
 }
 
+ok(
+    RoleWithRoleHCA->meta()->does_role('RoleHCA'),
+    'RoleWithRoleHCA does RoleHCA'
+);
+
 {
     package ClassWithRoleWithRoleHCA;
 
@@ -99,9 +102,8 @@ is_deeply(
     }
 }
 
-is_deeply(
-    [ map { $_->name() } ClassWithRoleHCA->meta()->calculate_all_roles() ],
-    ['RoleHCA'],
+ok(
+    ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'),
     'ClassWithRoleWithRoleHCA does RoleHCA'
 );
 
@@ -109,9 +111,8 @@ SharedTests::run_tests('ClassWithRoleWithRoleHCA');
 
 ClassWithRoleWithRoleHCA->meta()->make_immutable();
 
-is_deeply(
-    [ map { $_->name() } ClassWithRoleHCA->meta()->calculate_all_roles() ],
-    ['RoleHCA'],
+ok(
+    ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'),
     'ClassWithRoleWithRoleHCA (immutable) does RoleHCA'
 );
 
@@ -137,9 +138,8 @@ my $instance = InstanceWithRoleHCA->new();
 
 apply_all_roles( $instance, 'RoleHCA' );
 
-is_deeply(
-    [ map { $_->name() } $instance->meta()->calculate_all_roles() ],
-    ['RoleHCA'],
+ok(
+    $instance->meta()->does_role('RoleHCA'),
     '$instance does RoleHCA'
 );
 
@@ -149,9 +149,8 @@ SharedTests::run_tests($instance);
 
 $instance->meta()->make_immutable();
 
-is_deeply(
-    [ map { $_->name() } $instance->meta()->calculate_all_roles() ],
-    ['RoleHCA'],
+ok(
+    $instance->meta()->does_role('RoleHCA'),
     '$instance (immutable) does RoleHCA'
 );