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