Commit | Line | Data |
6d6d2327 |
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 | { local $TODO = "metaclass compatibility fixing doesn't notice things unless the class or instance metaclass change"; |
47 | Foo::Sub->new; |
48 | is($called, 2, "subclass inherits constructor traits"); |
49 | |
50 | ok(Foo::Sub->meta->constructor_class->meta->can('does_role') |
51 | && Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'), |
52 | "subclass inherits constructor traits"); |
53 | } |
54 | |
55 | done_testing; |