Commit | Line | Data |
84ef660f |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
fc3207cd |
6 | use Test::More; |
7 | BEGIN { |
de252f0e |
8 | plan skip_all => "Moose required for this test" unless eval { require Moose && Moose->VERSION('0.59') }; |
fc3207cd |
9 | plan tests => 27; |
10 | } |
11 | |
8c831d08 |
12 | use Mouse::Util ':test'; |
84ef660f |
13 | |
14 | { |
15 | package Foo; |
16 | use Mouse; |
17 | |
18 | has foo => ( |
19 | isa => "Int", |
20 | is => "rw", |
21 | ); |
22 | |
23 | package Bar; |
24 | use Moose; |
25 | |
26 | ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose"; |
27 | |
28 | ::lives_ok { |
29 | has bar => ( |
30 | isa => "Str", |
31 | is => "rw", |
32 | ); |
33 | } "new attr in subclass"; |
34 | |
35 | package Gorch; |
36 | use Moose; |
37 | |
38 | ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose"; |
39 | |
40 | { |
41 | local our $TODO = "Moose not yet aware of Mouse meta"; |
42 | ::lives_ok { |
43 | has '+foo' => ( |
44 | default => 3, |
45 | ); |
46 | } "clone and inherit attr in subclass"; |
47 | } |
48 | |
49 | package Quxx; |
50 | use Mouse; |
51 | |
52 | has quxx => ( |
53 | is => "rw", |
54 | default => "lala", |
55 | ); |
56 | |
57 | package Zork; |
58 | use Moose; |
59 | |
60 | ::lives_ok { extends qw(Quxx) } "extend Mouse class with Moose"; |
61 | |
62 | has zork => ( |
63 | is => "rw", |
64 | default => 42, |
65 | ); |
66 | } |
67 | |
68 | can_ok( Bar => "new" ); |
69 | |
70 | my $bar = eval { Bar->new }; |
71 | |
72 | ok( $bar, "got an object" ); |
73 | isa_ok( $bar, "Bar" ); |
74 | isa_ok( $bar, "Foo" ); |
75 | |
76 | can_ok( $bar, qw(foo bar) ); |
77 | |
78 | is( eval { $bar->foo }, undef, "no default value" ); |
79 | is( eval { $bar->bar }, undef, "no default value" ); |
80 | |
81 | { |
82 | local $TODO = "Moose not yet aware of Mouse meta"; |
83 | |
84 | |
85 | is_deeply( |
86 | [ sort map { $_->name } Bar->meta->compute_all_applicable_attributes ], |
87 | [ sort qw(foo bar) ], |
88 | "attributes", |
89 | ); |
90 | |
91 | is( eval { Gorch->new->foo }, 3, "cloned and inherited attr's default" ); |
92 | } |
93 | |
94 | can_ok( Zork => "new" ); |
95 | |
96 | { |
97 | my $zork = eval { Zork->new }; |
98 | |
99 | ok( $zork, "got an object" ); |
100 | isa_ok( $zork, "Zork" ); |
101 | isa_ok( $zork, "Quxx" ); |
102 | |
103 | can_ok( $zork, qw(quxx zork) ); |
104 | |
105 | local $TODO = "Constructor needs to know default values of attrs from both"; |
106 | is( eval { $bar->quxx }, "lala", "default value" ); |
107 | is( eval { $bar->zork }, 42, "default value" ); |
108 | } |
109 | |
110 | { |
111 | my $zork = eval { Zork->new( zork => "diff", quxx => "blah" ) }; |
112 | |
113 | ok( $zork, "got an object" ); |
114 | isa_ok( $zork, "Zork" ); |
115 | isa_ok( $zork, "Quxx" ); |
116 | |
117 | can_ok( $zork, qw(quxx zork) ); |
118 | |
119 | local $TODO = "Constructor needs to know init args of attrs from both"; |
120 | is( eval { $bar->quxx }, "blah", "constructor param" ); |
121 | is( eval { $bar->zork }, "diff", "constructor param" ); |
122 | } |