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