Commit | Line | Data |
0aac92c5 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
7ff56534 |
6 | use Test::More tests => 8; |
0aac92c5 |
7 | use Test::Exception; |
8 | use Scalar::Util 'blessed'; |
9 | |
61c0fc9f |
10 | =pod |
11 | |
12 | This test it kind of odd, it tests |
13 | to see if make_immutable will DWIM |
14 | when pressented with a class that |
15 | inherits from a non-Moose base class. |
16 | |
17 | Since immutable only affects the local |
18 | class, and if it doesnt find a constructor |
19 | it will always create one, it won't |
20 | discover this issue, and it will ignore |
21 | the inherited constructor. |
22 | |
23 | This is not really the desired way, but |
24 | detecting this opens a big can of worms |
25 | which we are not going to deal with just |
26 | yet (eventually yes, but most likely it |
27 | will be when we have MooseX::Compile |
28 | available and working). |
29 | |
30 | In the meantime, just know that when you |
31 | call make_immutable on a class which |
32 | inherits from a non-Moose class, you |
33 | should add (inline_constructor => 0). |
34 | |
35 | Sorry Sartak. |
36 | |
37 | =cut |
38 | |
0aac92c5 |
39 | { |
40 | package Grandparent; |
41 | |
42 | sub new { |
43 | my $class = shift; |
44 | my %args = ( |
45 | grandparent => 'gramma', |
46 | @_, |
47 | ); |
48 | |
49 | bless \%args => $class; |
50 | } |
51 | |
52 | sub grandparent { 1 } |
53 | } |
54 | |
55 | { |
56 | package Parent; |
57 | use Moose; |
58 | extends 'Grandparent'; |
59 | |
60 | around new => sub { |
61 | my $orig = shift; |
62 | my $class = shift; |
63 | |
64 | $class->$orig( |
65 | parent => 'mama', |
66 | @_, |
67 | ); |
68 | }; |
69 | |
70 | sub parent { 1 } |
71 | } |
72 | |
73 | { |
74 | package Child; |
75 | use Moose; |
76 | extends 'Parent'; |
77 | |
78 | sub child { 1 } |
79 | |
5a3217de |
80 | __PACKAGE__->meta->make_immutable; |
0aac92c5 |
81 | } |
82 | |
83 | is(blessed(Grandparent->new), "Grandparent", "got a Grandparent object out of Grandparent->new"); |
84 | is(blessed(Parent->new), "Parent", "got a Parent object out of Parent->new"); |
85 | is(blessed(Child->new), "Child", "got a Child object out of Child->new"); |
86 | |
87 | is(Child->new->grandparent, 1, "Child responds to grandparent"); |
88 | is(Child->new->parent, 1, "Child responds to parent"); |
89 | is(Child->new->child, 1, "Child responds to child"); |
90 | |
61c0fc9f |
91 | is(Child->new->{grandparent}, undef, "didnt create a value, cause immutable overode the constructor"); |
92 | is(Child->new->{parent}, undef, "didnt create a value, cause immutable overode the constructor"); |
93 | |
0aac92c5 |
94 | |