Commit | Line | Data |
36062241 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
069668c4 |
4 | use Test::More tests => 11; |
36062241 |
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"); |
28d26949 |
28 | |
ad022aac |
29 | is_deeply([sort(Child->meta->get_all_attributes)], [sort( |
28d26949 |
30 | Child->meta->get_attribute('child'), |
31 | Class->meta->get_attribute('class'), |
ad022aac |
32 | )], "correct get_all_attributes"); |
28d26949 |
33 | |
069668c4 |
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 | |
0eaf53c2 |
64 | is_deeply([Foo->meta->get_all_attributes], [ |
069668c4 |
65 | Foo->meta->get_attribute('attr'), |
0eaf53c2 |
66 | ], "correct get_all_attributes"); |
069668c4 |
67 | |
0eaf53c2 |
68 | is_deeply([Bar->meta->get_all_attributes], [ |
069668c4 |
69 | Bar->meta->get_attribute('attr'), |
0eaf53c2 |
70 | ], "correct get_all_attributes"); |
069668c4 |
71 | |