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     ::ok ! ::exception { $meta->superclasses('Foo2') }, "can set superclasses once";
  78     ::isa_ok($meta, Foo2->meta->meta->name);
  79     ::ok ! ::exception { $meta->superclasses('Bar2') }, "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     ::ok ! ::exception { $meta->make_immutable }, "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     ::ok ! ::exception { $meta->superclasses('Foo2') }, "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     ::ok ! ::exception { $meta->superclasses('Bar3') }, "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     ::ok ! ::exception { $meta->make_immutable }, "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     ::ok ! ::exception { $meta->superclasses('Foo2') }, "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     ::ok ! ::exception { $meta->superclasses('Quux3') }, "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     ::ok ! ::exception { $meta->make_immutable }, "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     ::ok ! ::exception { $meta->superclasses('Foo4') }, "can set superclasses once";
 155     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 156     ::ok ! ::exception { $meta->superclasses('Bar4') }, "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     ::ok ! ::exception { $meta->make_immutable }, "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     ::ok ! ::exception { $meta->superclasses('Foo4') }, "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     ::ok ! ::exception { $meta->superclasses('Bar5') }, "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     ::ok ! ::exception { $meta->make_immutable }, "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     ::ok ! ::exception { $meta->superclasses('Foo4') }, "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     ::ok ! ::exception { $meta->superclasses('Quux5') }, "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     ::ok ! ::exception { $meta->make_immutable }, "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     ::ok ! ::exception {
 237         extends @superclasses;
 238     }, 'MI extends after_generated_methods with metaclass roles';
 239     ::ok ! ::exception {
 240         extends reverse @superclasses;
 241     },
 242     'MI extends after_generated_methods with metaclass roles (reverse)';
 243 }
 244
 245 {
 246     package Foo6::Meta::Role;
 247     use Moose::Role;
 248 }
 249 {
 250     package Foo6::SuperClass::WithMetaRole;
 251     use Moose -traits =>'Foo6::Meta::Role';
 252 }
 253 {
 254     package Foo6::Meta::OtherRole;
 255     use Moose::Role;
 256 }
 257 {
 258     package Foo6::SuperClass::After::Attribute;
 259     use Moose -traits =>'Foo6::Meta::OtherRole';
 260 }
 261 {
 262     package Foo6;
 263     use Moose;
 264     my @superclasses = ('Foo6::SuperClass::WithMetaRole');
 265     extends @superclasses;
 266
 267     has an_attribute_generating_methods => ( is => 'ro' );
 268
 269     push(@superclasses, 'Foo6::SuperClass::After::Attribute');
 270
 271     ::like ::exception {
 272         extends @superclasses;
 273     }, qr/compat.*pristine/,
 274     'unsafe MI extends after_generated_methods with metaclass roles';
 275     ::like ::exception {
 276         extends reverse @superclasses;
 277     }, qr/compat.*pristine/,
 278     'unsafe MI extends after_generated_methods with metaclass roles (reverse)';
 279 }
 280
 281 {
 282     package Foo7::Meta::Trait;
 283     use Moose::Role;
 284 }
 285
 286 {
 287     package Foo7;
 288     use Moose -traits => ['Foo7::Meta::Trait'];
 289 }
 290
 291 {
 292     package Bar7;
 293     # in an external file
 294     use Moose -traits => ['Bar7::Meta::Trait'];
 295     ::ok ! ::exception { extends 'Foo7' }, "role reconciliation works";
 296 }
 297
 298 {
 299     package Bar72;
 300     # in an external file
 301     use Moose -traits => ['Bar7::Meta::Trait2'];
 302     ::ok ! ::exception { extends 'Foo7' }, "role reconciliation works";
 303 }
 304
 305 done_testing;