t/06-role.t

   1 use strict;
   2 use warnings;
   3
   4 use lib 't/lib';
   5
   6 use SharedTests;
   7 use Test::More;
   8
   9 use Moose::Util qw( apply_all_roles );
  10
  11 {
  12     package RoleHCA;
  13
  14     use Moose::Role;
  15     use MooseX::ClassAttribute;
  16
  17     while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
  18         class_has $name => %{$def};
  19     }
  20 }
  21
  22 {
  23     package ClassWithRoleHCA;
  24
  25     use Moose;
  26
  27     with 'RoleHCA';
  28
  29     has 'size' => (
  30         is      => 'rw',
  31         isa     => 'Int',
  32         default => 5,
  33     );
  34
  35     sub BUILD {
  36         my $self = shift;
  37
  38         $self->ObjectCount( $self->ObjectCount() + 1 );
  39     }
  40
  41     sub _BuildIt { 42 }
  42
  43     sub _CallTrigger {
  44         push @{ $_[0]->TriggerRecord() }, [@_];
  45     }
  46 }
  47
  48 ok(
  49     ClassWithRoleHCA->meta()->does_role('RoleHCA'),
  50     'ClassWithRoleHCA does RoleHCA'
  51 );
  52
  53 SharedTests::run_tests('ClassWithRoleHCA');
  54
  55 ClassWithRoleHCA->meta()->make_immutable();
  56
  57 ok(
  58     ClassWithRoleHCA->meta()->does_role('RoleHCA'),
  59     'ClassWithRoleHCA (immutable) does RoleHCA'
  60 );
  61
  62 # These next tests are aimed at testing to-role application followed by
  63 # to-class application
  64 {
  65     package RoleWithRoleHCA;
  66
  67     use Moose::Role;
  68     use MooseX::ClassAttribute;
  69
  70     with 'RoleHCA';
  71 }
  72
  73 ok(
  74     RoleWithRoleHCA->meta()->does_role('RoleHCA'),
  75     'RoleWithRoleHCA does RoleHCA'
  76 );
  77
  78 {
  79     package ClassWithRoleWithRoleHCA;
  80
  81     use Moose;
  82
  83     with 'RoleWithRoleHCA';
  84
  85     has 'size' => (
  86         is      => 'rw',
  87         isa     => 'Int',
  88         default => 5,
  89     );
  90
  91     sub BUILD {
  92         my $self = shift;
  93
  94         $self->ObjectCount( $self->ObjectCount() + 1 );
  95     }
  96
  97     sub _BuildIt { 42 }
  98
  99     sub _CallTrigger {
 100         push @{ $_[0]->TriggerRecord() }, [@_];
 101     }
 102 }
 103
 104 ok(
 105     ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'),
 106     'ClassWithRoleWithRoleHCA does RoleHCA'
 107 );
 108
 109 SharedTests::run_tests('ClassWithRoleWithRoleHCA');
 110
 111 ClassWithRoleWithRoleHCA->meta()->make_immutable();
 112
 113 ok(
 114     ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'),
 115     'ClassWithRoleWithRoleHCA (immutable) does RoleHCA'
 116 );
 117
 118 {
 119     package InstanceWithRoleHCA;
 120
 121     use Moose;
 122
 123     has 'size' => (
 124         is      => 'rw',
 125         isa     => 'Int',
 126         default => 5,
 127     );
 128
 129     sub _BuildIt { 42 }
 130
 131     sub _CallTrigger {
 132         push @{ $_[0]->TriggerRecord() }, [@_];
 133     }
 134 }
 135
 136 my $instance = InstanceWithRoleHCA->new();
 137
 138 apply_all_roles( $instance, 'RoleHCA' );
 139
 140 ok(
 141     $instance->meta()->does_role('RoleHCA'),
 142     '$instance does RoleHCA'
 143 );
 144
 145 $instance->ObjectCount(1);
 146
 147 SharedTests::run_tests($instance);
 148
 149 $instance->meta()->make_immutable();
 150
 151 ok(
 152     $instance->meta()->does_role('RoleHCA'),
 153     '$instance (immutable) does RoleHCA'
 154 );
 155
 156 done_testing();