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