t/050_metaclasses/052_metaclass_compat.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use lib 't/lib';
   5 use Test::More;
   6 use Test::Fatal;
   7
   8 our $called = 0;
   9 {
  10     package Foo::Trait::Constructor;
  11     use Moose::Role;
  12
  13     around _generate_BUILDALL => sub {
  14         my $orig = shift;
  15         my $self = shift;
  16         return $self->$orig(@_) . '$::called++;';
  17     }
  18 }
  19
  20 {
  21     package Foo;
  22     use Moose;
  23     Moose::Util::MetaRole::apply_metaroles(
  24         for => __PACKAGE__,
  25         class_metaroles => {
  26             constructor => ['Foo::Trait::Constructor'],
  27         }
  28     );
  29 }
  30
  31 Foo->new;
  32 is($called, 0, "no calls before inlining");
  33 Foo->meta->make_immutable;
  34
  35 Foo->new;
  36 is($called, 1, "inlined constructor has trait modifications");
  37
  38 ok(Foo->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
  39    "class has correct constructor traits");
  40
  41 {
  42     package Foo::Sub;
  43     use Moose;
  44     extends 'Foo';
  45 }
  46
  47 $called = 0;
  48
  49 Foo::Sub->new;
  50 is($called, 0, "no calls before inlining");
  51
  52 Foo::Sub->meta->make_immutable;
  53
  54 Foo::Sub->new;
  55 is($called, 1, "inherits constructor trait properly");
  56
  57 ok(Foo::Sub->meta->constructor_class->meta->can('does_role')
  58 && Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
  59    "subclass inherits constructor traits");
  60
  61 {
  62     package Foo2::Role;
  63     use Moose::Role;
  64 }
  65 {
  66     package Foo2;
  67     use Moose -traits => ['Foo2::Role'];
  68 }
  69 {
  70     package Bar2;
  71     use Moose;
  72 }
  73 {
  74     package Baz2;
  75     use Moose;
  76     my $meta = __PACKAGE__->meta;
  77     ::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" );
  78     ::isa_ok($meta, Foo2->meta->meta->name);
  79     ::is( ::exception { $meta->superclasses('Bar2') }, undef, "can still set superclasses" );
  80     ::isa_ok($meta, Bar2->meta->meta->name);
  81     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
  82                 ['Foo2::Role'],
  83                 "still have the role attached");
  84     ::ok(!$meta->is_immutable,
  85        "immutable superclass doesn't make this class immutable");
  86     ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
  87 }
  88 {
  89     package Foo3::Role;
  90     use Moose::Role;
  91 }
  92 {
  93     package Bar3;
  94     use Moose -traits => ['Foo3::Role'];
  95 }
  96 {
  97     package Baz3;
  98     use Moose -traits => ['Foo3::Role'];
  99     my $meta = __PACKAGE__->meta;
 100     ::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" );
 101     ::isa_ok($meta, Foo2->meta->meta->name);
 102     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 103                 ['Foo2::Role', 'Foo3::Role'],
 104                 "reconciled roles correctly");
 105     ::is( ::exception { $meta->superclasses('Bar3') }, undef, "can still set superclasses" );
 106     ::isa_ok($meta, Bar3->meta->meta->name);
 107     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 108                 ['Foo2::Role', 'Foo3::Role'],
 109                 "roles still the same");
 110     ::ok(!$meta->is_immutable,
 111        "immutable superclass doesn't make this class immutable");
 112     ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
 113 }
 114 {
 115     package Quux3;
 116     use Moose;
 117 }
 118 {
 119     package Quuux3;
 120     use Moose -traits => ['Foo3::Role'];
 121     my $meta = __PACKAGE__->meta;
 122     ::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" );
 123     ::isa_ok($meta, Foo2->meta->meta->name);
 124     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 125                 ['Foo2::Role', 'Foo3::Role'],
 126                 "reconciled roles correctly");
 127     ::is( ::exception { $meta->superclasses('Quux3') }, undef, "can still set superclasses" );
 128     ::isa_ok($meta, Quux3->meta->meta->name);
 129     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 130                 ['Foo2::Role', 'Foo3::Role'],
 131                 "roles still the same");
 132     ::ok(!$meta->is_immutable,
 133        "immutable superclass doesn't make this class immutable");
 134     ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
 135 }
 136
 137 {
 138     package Foo4::Role;
 139     use Moose::Role;
 140 }
 141 {
 142     package Foo4;
 143     use Moose -traits => ['Foo4::Role'];
 144     __PACKAGE__->meta->make_immutable;
 145 }
 146 {
 147     package Bar4;
 148     use Moose;
 149 }
 150 {
 151     package Baz4;
 152     use Moose;
 153     my $meta = __PACKAGE__->meta;
 154     ::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" );
 155     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 156     ::is( ::exception { $meta->superclasses('Bar4') }, undef, "can still set superclasses" );
 157     ::isa_ok($meta, Bar4->meta->meta->name);
 158     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 159                 ['Foo4::Role'],
 160                 "still have the role attached");
 161     ::ok(!$meta->is_immutable,
 162        "immutable superclass doesn't make this class immutable");
 163     ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
 164 }
 165 {
 166     package Foo5::Role;
 167     use Moose::Role;
 168 }
 169 {
 170     package Bar5;
 171     use Moose -traits => ['Foo5::Role'];
 172 }
 173 {
 174     package Baz5;
 175     use Moose -traits => ['Foo5::Role'];
 176     my $meta = __PACKAGE__->meta;
 177     ::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" );
 178     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 179     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 180                 ['Foo4::Role', 'Foo5::Role'],
 181                 "reconciled roles correctly");
 182     ::is( ::exception { $meta->superclasses('Bar5') }, undef, "can still set superclasses" );
 183     ::isa_ok($meta, Bar5->meta->meta->name);
 184     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 185                 ['Foo4::Role', 'Foo5::Role'],
 186                 "roles still the same");
 187     ::ok(!$meta->is_immutable,
 188        "immutable superclass doesn't make this class immutable");
 189     ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
 190 }
 191 {
 192     package Quux5;
 193     use Moose;
 194 }
 195 {
 196     package Quuux5;
 197     use Moose -traits => ['Foo5::Role'];
 198     my $meta = __PACKAGE__->meta;
 199     ::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" );
 200     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 201     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 202                 ['Foo4::Role', 'Foo5::Role'],
 203                 "reconciled roles correctly");
 204     ::is( ::exception { $meta->superclasses('Quux5') }, undef, "can still set superclasses" );
 205     ::isa_ok($meta, Quux5->meta->meta->name);
 206     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 207                 ['Foo4::Role', 'Foo5::Role'],
 208                 "roles still the same");
 209     ::ok(!$meta->is_immutable,
 210        "immutable superclass doesn't make this class immutable");
 211     ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
 212 }
 213
 214 {
 215     package Foo5::Meta::Role;
 216     use Moose::Role;
 217 }
 218 {
 219     package Foo5::SuperClass::WithMetaRole;
 220     use Moose -traits =>'Foo5::Meta::Role';
 221 }
 222 {
 223     package Foo5::SuperClass::After::Attribute;
 224     use Moose;
 225 }
 226 {
 227     package Foo5;
 228     use Moose;
 229     my @superclasses = ('Foo5::SuperClass::WithMetaRole');
 230     extends @superclasses;
 231
 232     has an_attribute_generating_methods => ( is => 'ro' );
 233
 234     push(@superclasses, 'Foo5::SuperClass::After::Attribute');
 235
 236     ::is( ::exception {
 237         extends @superclasses;
 238     }, undef, 'MI extends after_generated_methods with metaclass roles' );
 239     ::is( ::exception {
 240         extends reverse @superclasses;
 241     }, undef, 'MI extends after_generated_methods with metaclass roles (reverse)' );
 242 }
 243
 244 {
 245     package Foo6::Meta::Role;
 246     use Moose::Role;
 247 }
 248 {
 249     package Foo6::SuperClass::WithMetaRole;
 250     use Moose -traits =>'Foo6::Meta::Role';
 251 }
 252 {
 253     package Foo6::Meta::OtherRole;
 254     use Moose::Role;
 255 }
 256 {
 257     package Foo6::SuperClass::After::Attribute;
 258     use Moose -traits =>'Foo6::Meta::OtherRole';
 259 }
 260 {
 261     package Foo6;
 262     use Moose;
 263     my @superclasses = ('Foo6::SuperClass::WithMetaRole');
 264     extends @superclasses;
 265
 266     has an_attribute_generating_methods => ( is => 'ro' );
 267
 268     push(@superclasses, 'Foo6::SuperClass::After::Attribute');
 269
 270     ::like( ::exception {
 271         extends @superclasses;
 272     }, qr/compat.*pristine/, 'unsafe MI extends after_generated_methods with metaclass roles' );
 273     ::like( ::exception {
 274         extends reverse @superclasses;
 275     }, qr/compat.*pristine/, 'unsafe MI extends after_generated_methods with metaclass roles (reverse)' );
 276 }
 277
 278 {
 279     package Foo7::Meta::Trait;
 280     use Moose::Role;
 281 }
 282
 283 {
 284     package Foo7;
 285     use Moose -traits => ['Foo7::Meta::Trait'];
 286 }
 287
 288 {
 289     package Bar7;
 290     # in an external file
 291     use Moose -traits => ['Bar7::Meta::Trait'];
 292     ::is( ::exception { extends 'Foo7' }, undef, "role reconciliation works" );
 293 }
 294
 295 {
 296     package Bar72;
 297     # in an external file
 298     use Moose -traits => ['Bar7::Meta::Trait2'];
 299     ::is( ::exception { extends 'Foo7' }, undef, "role reconciliation works" );
 300 }
 301
 302 done_testing;