t/600_todo_tests/007_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 done_testing;