t/050_metaclasses/052_metaclass_compat.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6
   7 our $called = 0;
   8 {
   9     package Foo::Trait::Constructor;
  10     use Moose::Role;
  11
  12     around _generate_BUILDALL => sub {
  13         my $orig = shift;
  14         my $self = shift;
  15         return $self->$orig(@_) . '$::called++;';
  16     }
  17 }
  18
  19 {
  20     package Foo;
  21     use Moose;
  22     Moose::Util::MetaRole::apply_metaroles(
  23         for => __PACKAGE__,
  24         class_metaroles => {
  25             constructor => ['Foo::Trait::Constructor'],
  26         }
  27     );
  28 }
  29
  30 Foo->new;
  31 is($called, 0, "no calls before inlining");
  32 Foo->meta->make_immutable;
  33
  34 Foo->new;
  35 is($called, 1, "inlined constructor has trait modifications");
  36
  37 ok(Foo->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
  38    "class has correct constructor traits");
  39
  40 {
  41     package Foo::Sub;
  42     use Moose;
  43     extends 'Foo';
  44 }
  45
  46 $called = 0;
  47
  48 Foo::Sub->new;
  49 is($called, 0, "no calls before inlining");
  50
  51 Foo::Sub->meta->make_immutable;
  52
  53 Foo::Sub->new;
  54 is($called, 1, "inherits constructor trait properly");
  55
  56 ok(Foo::Sub->meta->constructor_class->meta->can('does_role')
  57 && Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
  58    "subclass inherits constructor traits");
  59
  60 {
  61     package Foo2::Role;
  62     use Moose::Role;
  63 }
  64 {
  65     package Foo2;
  66     use Moose -traits => ['Foo2::Role'];
  67 }
  68 {
  69     package Bar2;
  70     use Moose;
  71 }
  72 {
  73     package Baz2;
  74     use Moose;
  75     my $meta = __PACKAGE__->meta;
  76     ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once";
  77     ::isa_ok($meta, Foo2->meta->meta->name);
  78     ::lives_ok { $meta->superclasses('Bar2') } "can still set superclasses";
  79     ::isa_ok($meta, Bar2->meta->meta->name);
  80     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
  81                 ['Foo2::Role'],
  82                 "still have the role attached");
  83     ::ok(!$meta->is_immutable,
  84        "immutable superclass doesn't make this class immutable");
  85     ::lives_ok { $meta->make_immutable } "can still make immutable";
  86 }
  87 {
  88     package Foo3::Role;
  89     use Moose::Role;
  90 }
  91 {
  92     package Bar3;
  93     use Moose -traits => ['Foo3::Role'];
  94 }
  95 {
  96     package Baz3;
  97     use Moose -traits => ['Foo3::Role'];
  98     my $meta = __PACKAGE__->meta;
  99     ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once";
 100     ::isa_ok($meta, Foo2->meta->meta->name);
 101     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 102                 ['Foo2::Role', 'Foo3::Role'],
 103                 "reconciled roles correctly");
 104     ::lives_ok { $meta->superclasses('Bar3') } "can still set superclasses";
 105     ::isa_ok($meta, Bar3->meta->meta->name);
 106     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 107                 ['Foo2::Role', 'Foo3::Role'],
 108                 "roles still the same");
 109     ::ok(!$meta->is_immutable,
 110        "immutable superclass doesn't make this class immutable");
 111     ::lives_ok { $meta->make_immutable } "can still make immutable";
 112 }
 113 {
 114     package Quux3;
 115     use Moose;
 116 }
 117 {
 118     package Quuux3;
 119     use Moose -traits => ['Foo3::Role'];
 120     my $meta = __PACKAGE__->meta;
 121     ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once";
 122     ::isa_ok($meta, Foo2->meta->meta->name);
 123     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 124                 ['Foo2::Role', 'Foo3::Role'],
 125                 "reconciled roles correctly");
 126     ::lives_ok { $meta->superclasses('Quux3') } "can still set superclasses";
 127     ::isa_ok($meta, Quux3->meta->meta->name);
 128     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 129                 ['Foo2::Role', 'Foo3::Role'],
 130                 "roles still the same");
 131     ::ok(!$meta->is_immutable,
 132        "immutable superclass doesn't make this class immutable");
 133     ::lives_ok { $meta->make_immutable } "can still make immutable";
 134 }
 135
 136 {
 137     package Foo4::Role;
 138     use Moose::Role;
 139 }
 140 {
 141     package Foo4;
 142     use Moose -traits => ['Foo4::Role'];
 143     __PACKAGE__->meta->make_immutable;
 144 }
 145 {
 146     package Bar4;
 147     use Moose;
 148 }
 149 {
 150     package Baz4;
 151     use Moose;
 152     my $meta = __PACKAGE__->meta;
 153     ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once";
 154     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 155     ::lives_ok { $meta->superclasses('Bar4') } "can still set superclasses";
 156     ::isa_ok($meta, Bar4->meta->meta->name);
 157     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 158                 ['Foo4::Role'],
 159                 "still have the role attached");
 160     ::ok(!$meta->is_immutable,
 161        "immutable superclass doesn't make this class immutable");
 162     ::lives_ok { $meta->make_immutable } "can still make immutable";
 163 }
 164 {
 165     package Foo5::Role;
 166     use Moose::Role;
 167 }
 168 {
 169     package Bar5;
 170     use Moose -traits => ['Foo5::Role'];
 171 }
 172 {
 173     package Baz5;
 174     use Moose -traits => ['Foo5::Role'];
 175     my $meta = __PACKAGE__->meta;
 176     ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once";
 177     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 178     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 179                 ['Foo4::Role', 'Foo5::Role'],
 180                 "reconciled roles correctly");
 181     ::lives_ok { $meta->superclasses('Bar5') } "can still set superclasses";
 182     ::isa_ok($meta, Bar5->meta->meta->name);
 183     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 184                 ['Foo4::Role', 'Foo5::Role'],
 185                 "roles still the same");
 186     ::ok(!$meta->is_immutable,
 187        "immutable superclass doesn't make this class immutable");
 188     ::lives_ok { $meta->make_immutable } "can still make immutable";
 189 }
 190 {
 191     package Quux5;
 192     use Moose;
 193 }
 194 {
 195     package Quuux5;
 196     use Moose -traits => ['Foo5::Role'];
 197     my $meta = __PACKAGE__->meta;
 198     ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once";
 199     ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
 200     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 201                 ['Foo4::Role', 'Foo5::Role'],
 202                 "reconciled roles correctly");
 203     ::lives_ok { $meta->superclasses('Quux5') } "can still set superclasses";
 204     ::isa_ok($meta, Quux5->meta->meta->name);
 205     ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
 206                 ['Foo4::Role', 'Foo5::Role'],
 207                 "roles still the same");
 208     ::ok(!$meta->is_immutable,
 209        "immutable superclass doesn't make this class immutable");
 210     ::lives_ok { $meta->make_immutable } "can still make immutable";
 211 }
 212
 213 done_testing;