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