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