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     __PACKAGE__->meta->make_immutable;
  68 }
  69 {
  70     package Bar2;
  71     use Moose;
  72 }
  73 {
  74     package Baz2;
  75     use Moose;
  76     my $meta = __PACKAGE__->meta;
  77     $meta->superclasses('Foo2');
  78     { our $TODO; local $TODO = "need to handle immutability better";
  79     ::lives_ok { $meta->superclasses('Bar2') };
  80     }
  81 }
  82
  83 done_testing;