Changes
[gitmo/Mouse.git] / t / 028-subclass-attr.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 11;
5
6 do {
7     package Class;
8     use Mouse;
9
10     has class => (
11         is  => 'rw',
12         isa => 'Bool',
13     );
14
15     package Child;
16     use Mouse;
17     extends 'Class';
18
19     has child => (
20         is  => 'rw',
21         isa => 'Bool',
22     );
23 };
24
25 my $obj = Child->new(class => 1, child => 1);
26 ok($obj->child, "local attribute set in constructor");
27 ok($obj->class, "inherited attribute set in constructor");
28
29 is_deeply([Child->meta->compute_all_applicable_attributes], [
30     Child->meta->get_attribute('child'),
31     Class->meta->get_attribute('class'),
32 ], "correct compute_all_applicable_attributes");
33
34 do {
35     package Foo;
36     use Mouse;
37
38     has attr => (
39         is      => 'ro',
40         default => 'Foo',
41     );
42
43     package Bar;
44     use Mouse;
45     extends 'Foo';
46
47     has attr => (
48         is => 'rw',
49     );
50 };
51
52 my $foo = Foo->new;
53 is($foo->attr, 'Foo', 'subclass does not affect parent attr');
54
55 my $bar = Bar->new;
56 is($bar->attr, undef, 'new attribute does not have the new default');
57
58 is(Foo->meta->get_attribute('attr')->default, 'Foo');
59 is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro');
60
61 is(Bar->meta->get_attribute('attr')->default, undef);
62 is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw');
63
64 is_deeply([Foo->meta->compute_all_applicable_attributes], [
65     Foo->meta->get_attribute('attr'),
66 ], "correct compute_all_applicable_attributes");
67
68 is_deeply([Bar->meta->compute_all_applicable_attributes], [
69     Bar->meta->get_attribute('attr'),
70 ], "correct compute_all_applicable_attributes");
71