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