t/roles/role_attr_application.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Moose;
   6 use Moose::Util qw( does_role );
   7
   8 {
   9     package Foo::Meta::Attribute;
  10     use Moose::Role;
  11 }
  12
  13 {
  14     package Foo::Meta::Attribute2;
  15     use Moose::Role;
  16 }
  17
  18 {
  19     package Foo::Role;
  20     use Moose::Role;
  21
  22     has foo => (is => 'ro');
  23 }
  24
  25 {
  26     package Foo;
  27     use Moose;
  28     Moose::Util::MetaRole::apply_metaroles(
  29         for => __PACKAGE__,
  30         class_metaroles => { attribute => ['Foo::Meta::Attribute'] },
  31         role_metaroles  => { applied_attribute => ['Foo::Meta::Attribute2'] },
  32     );
  33     with 'Foo::Role';
  34
  35     has bar => (is => 'ro');
  36 }
  37
  38 ok(Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute'), "attrs defined in the class get the class metarole applied");
  39 ok(!Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied");
  40 ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the metarole applied");
  41 ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the role metarole defined in the class applied");
  42
  43 {
  44     package Bar::Meta::Attribute;
  45     use Moose::Role;
  46 }
  47
  48 {
  49     package Bar::Meta::Attribute2;
  50     use Moose::Role;
  51 }
  52
  53 {
  54     package Bar::Role;
  55     use Moose::Role;
  56     Moose::Util::MetaRole::apply_metaroles(
  57         for => __PACKAGE__,
  58         class_metaroles => { attribute => ['Bar::Meta::Attribute'] },
  59         role_metaroles  => { applied_attribute => ['Bar::Meta::Attribute2'] },
  60     );
  61
  62     has foo => (is => 'ro');
  63 }
  64
  65 {
  66     package Bar;
  67     use Moose;
  68     with 'Bar::Role';
  69
  70     has bar => (is => 'ro');
  71 }
  72
  73 ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute'), "attrs defined in the class don't get the class metarole from the role applied");
  74 ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied");
  75 ok(Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute2'), "attrs defined in the role get the role metarole applied");
  76 ok(!Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied");
  77
  78 {
  79     package Baz::Meta::Attribute;
  80     use Moose::Role;
  81 }
  82
  83 {
  84     package Baz::Meta::Attribute2;
  85     use Moose::Role;
  86 }
  87
  88 {
  89     package Baz::Role;
  90     use Moose::Role;
  91     Moose::Util::MetaRole::apply_metaroles(
  92         for => __PACKAGE__,
  93         class_metaroles => { attribute => ['Baz::Meta::Attribute'] },
  94         role_metaroles  => { applied_attribute => ['Baz::Meta::Attribute2'] },
  95     );
  96
  97     has foo => (is => 'ro');
  98 }
  99
 100 {
 101     package Baz;
 102     use Moose;
 103     Moose::Util::MetaRole::apply_metaroles(
 104         for => __PACKAGE__,
 105         class_metaroles => { attribute => ['Baz::Meta::Attribute'] },
 106         role_metaroles  => { applied_attribute => ['Baz::Meta::Attribute2'] },
 107     );
 108     with 'Baz::Role';
 109
 110     has bar => (is => 'ro');
 111 }
 112
 113 ok(Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute'), "attrs defined in the class get the class metarole applied");
 114 ok(!Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied");
 115 ok(Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute2'), "attrs defined in the role get the role metarole applied");
 116 ok(!Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied");
 117
 118 {
 119     package Accessor::Modifying::Role;
 120     use Moose::Role;
 121
 122     around _process_options => sub {
 123         my $orig = shift;
 124         my $self = shift;
 125         my ($name, $params) = @_;
 126         $self->$orig(@_);
 127         $params->{reader} .= '_foo';
 128     };
 129 }
 130
 131 {
 132     package Plain::Role;
 133     use Moose::Role;
 134
 135     has foo => (
 136         is  => 'ro',
 137         isa => 'Str',
 138     );
 139 }
 140
 141 {
 142     package Class::With::Trait;
 143     use Moose;
 144     Moose::Util::MetaRole::apply_metaroles(
 145         for => __PACKAGE__,
 146         class_metaroles => {
 147             attribute => ['Accessor::Modifying::Role'],
 148         },
 149     );
 150     with 'Plain::Role';
 151
 152     has bar => (
 153         is  => 'ro',
 154         isa => 'Str',
 155     );
 156 }
 157
 158 {
 159     can_ok('Class::With::Trait', 'foo');
 160     can_ok('Class::With::Trait', 'bar_foo');
 161 }
 162
 163 {
 164     package Role::With::Trait;
 165     use Moose::Role;
 166     Moose::Util::MetaRole::apply_metaroles(
 167         for => __PACKAGE__,
 168         role_metaroles => {
 169             applied_attribute => ['Accessor::Modifying::Role'],
 170         },
 171     );
 172     with 'Plain::Role';
 173
 174     has foo => (
 175         is  => 'ro',
 176         isa => 'Str',
 177     );
 178
 179     sub foo_test {
 180         my $self = shift;
 181         return $self->can('foo_foo');
 182     }
 183 }
 184
 185 {
 186     package Class::With::Role::With::Trait;
 187     use Moose;
 188     with 'Role::With::Trait';
 189
 190     has bar => (
 191         is  => 'ro',
 192         isa => 'Str',
 193     );
 194
 195     sub bar_test {
 196         my $self = shift;
 197         return $self->can('bar');
 198     }
 199 }
 200
 201 {
 202     can_ok('Class::With::Role::With::Trait', 'foo_foo');
 203     can_ok('Class::With::Role::With::Trait', 'bar');
 204 }
 205
 206 {
 207     package Quux::Meta::Role::Attribute;
 208     use Moose::Role;
 209 }
 210
 211 {
 212     package Quux::Role1;
 213     use Moose::Role;
 214
 215     has foo => (traits => ['Quux::Meta::Role::Attribute'], is => 'ro');
 216     has baz => (is => 'ro');
 217 }
 218
 219 {
 220     package Quux::Role2;
 221     use Moose::Role;
 222     Moose::Util::MetaRole::apply_metaroles(
 223         for            => __PACKAGE__,
 224         role_metaroles => {
 225             applied_attribute => ['Quux::Meta::Role::Attribute']
 226         },
 227     );
 228
 229     has bar => (is => 'ro');
 230 }
 231
 232 {
 233     package Quux;
 234     use Moose;
 235     with 'Quux::Role1', 'Quux::Role2';
 236 }
 237
 238 {
 239     my $foo = Quux->meta->get_attribute('foo');
 240     does_ok($foo, 'Quux::Meta::Role::Attribute',
 241             "individual attribute trait applied correctly");
 242
 243     my $baz = Quux->meta->get_attribute('baz');
 244     ok(! does_role($baz, 'Quux::Meta::Role::Attribute'),
 245        "applied_attribute traits do not end up applying to attributes from other roles during composition");
 246
 247     my $bar = Quux->meta->get_attribute('bar');
 248     does_ok($bar, 'Quux::Meta::Role::Attribute',
 249             "attribute metarole applied correctly");
 250 }
 251
 252 {
 253     package HasMeta;
 254     use Moose::Role;
 255     Moose::Util::MetaRole::apply_metaroles(
 256         for            => __PACKAGE__,
 257         role_metaroles => {
 258             applied_attribute => ['Quux::Meta::Role::Attribute']
 259         },
 260     );
 261
 262     has foo => (is => 'ro');
 263 }
 264
 265 {
 266     package NoMeta;
 267     use Moose::Role;
 268
 269     with 'HasMeta';
 270
 271     has bar => (is => 'ro');
 272 }
 273
 274 {
 275     package ConsumesBoth;
 276     use Moose;
 277     with 'HasMeta', 'NoMeta';
 278 }
 279
 280 {
 281     my $foo = ConsumesBoth->meta->get_attribute('foo');
 282     does_ok($foo, 'Quux::Meta::Role::Attribute',
 283             'applied_attribute traits are preserved when one role consumes another');
 284
 285     my $bar = ConsumesBoth->meta->get_attribute('bar');
 286     ok(! does_role($bar, 'Quux::Meta::Role::Attribute'),
 287        "applied_attribute traits do not spill over from consumed role");
 288 }
 289
 290
 291
 292 done_testing;