Commit | Line | Data |
86b99892 |
1 | use strict; |
2 | use warnings; |
13973ae9 |
3 | use Test::More tests => 4; |
86b99892 |
4 | use Mouse::Util::TypeConstraints; |
5 | |
89a97ba1 |
6 | subtype 'Foo', as 'Object', where { $_->isa('A') }; |
86b99892 |
7 | |
8 | { |
9 | package A; |
10 | use Mouse; |
11 | has data => ( is => 'rw', isa => 'Str' ); |
12 | } |
13 | |
14 | { |
89a97ba1 |
15 | package C; |
86b99892 |
16 | use Mouse; |
17 | has a => ( is => 'rw', isa => 'Foo', coerce => 1 ); |
18 | } |
19 | |
89a97ba1 |
20 | isa_ok(C->new(a => A->new()), 'C'); |
21 | C->meta->make_immutable; |
22 | isa_ok(C->new(a => A->new()), 'C'); |
86b99892 |
23 | |
13973ae9 |
24 | |
25 | |
26 | # The BUILD invocation order used to get reversed after |
27 | # making a class immutable. This checks it is correct. |
28 | { |
29 | package D; |
30 | use Mouse; |
31 | |
32 | # we'll keep |
33 | has order => |
34 | (is => 'ro', |
35 | default => sub {[]}); |
36 | |
37 | sub BUILD { push @{shift->order}, 'D' } |
38 | |
39 | package E; |
40 | use Mouse; |
41 | extends 'D'; |
42 | |
43 | sub BUILD { push @{shift->order}, 'E' } |
44 | |
45 | package F; |
46 | use Mouse; |
47 | extends 'E'; |
48 | |
49 | sub BUILD { push @{shift->order}, 'F' } |
50 | |
51 | |
52 | } |
53 | |
54 | my $obj = F->new; |
55 | |
56 | print join(", ", @{$obj->order}),"\n"; |
57 | is_deeply $obj->order, [qw(D E F)], "mutable BUILD invocation order correct"; |
58 | |
59 | # now make the classes immutable |
60 | $_->meta->make_immutable for qw(D E F); |
61 | |
62 | my $obj2 = F->new; |
63 | |
64 | print join(", ", @{$obj2->order}),"\n"; |
65 | is_deeply $obj2->order, [qw(D E F)], "immutable BUILD invocation order still correct"; |
66 | |
67 | |