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 SharedTests::run_tests('ClassWithRoleHCA');
  49
  50 # These next tests are aimed at testing to-role application followed by
  51 # to-class application
  52 {
  53     package RoleWithRoleHCA;
  54
  55     use Moose::Role;
  56     use MooseX::ClassAttribute;
  57
  58     with 'RoleHCA';
  59 }
  60
  61 {
  62     package ClassWithRoleWithRoleHCA;
  63
  64     use Moose;
  65
  66     with 'RoleWithRoleHCA';
  67
  68     has 'size' => (
  69         is      => 'rw',
  70         isa     => 'Int',
  71         default => 5,
  72     );
  73
  74     sub BUILD {
  75         my $self = shift;
  76
  77         $self->ObjectCount( $self->ObjectCount() + 1 );
  78     }
  79
  80     sub _BuildIt {42}
  81
  82     sub _CallTrigger {
  83         push @{ $_[0]->TriggerRecord() }, [@_];
  84     }
  85 }
  86
  87 SharedTests::run_tests('ClassWithRoleWithRoleHCA');
  88
  89 {
  90     package InstanceWithRoleHCA;
  91
  92     use Moose;
  93
  94     has 'size' => (
  95         is      => 'rw',
  96         isa     => 'Int',
  97         default => 5,
  98     );
  99
 100     sub _BuildIt {42}
 101
 102     sub _CallTrigger {
 103         push @{ $_[0]->TriggerRecord() }, [@_];
 104     }
 105 }
 106
 107 my $instance = InstanceWithRoleHCA->new();
 108
 109 apply_all_roles( $instance, 'RoleHCA' );
 110
 111 $instance->ObjectCount(1);
 112
 113 SharedTests::run_tests($instance);
 114
 115 done_testing();