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