Deprecate clone_instance
[gitmo/Mouse.git] / t / 028-subclass-attr.t
CommitLineData
36062241 1#!/usr/bin/env perl
2use strict;
3use warnings;
069668c4 4use Test::More tests => 11;
36062241 5
6do {
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
25my $obj = Child->new(class => 1, child => 1);
26ok($obj->child, "local attribute set in constructor");
27ok($obj->class, "inherited attribute set in constructor");
28d26949 28
ad022aac 29is_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 34do {
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
52my $foo = Foo->new;
53is($foo->attr, 'Foo', 'subclass does not affect parent attr');
54
55my $bar = Bar->new;
56is($bar->attr, undef, 'new attribute does not have the new default');
57
58is(Foo->meta->get_attribute('attr')->default, 'Foo');
59is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro');
60
61is(Bar->meta->get_attribute('attr')->default, undef);
62is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw');
63
0eaf53c2 64is_deeply([Foo->meta->get_all_attributes], [
069668c4 65 Foo->meta->get_attribute('attr'),
0eaf53c2 66], "correct get_all_attributes");
069668c4 67
0eaf53c2 68is_deeply([Bar->meta->get_all_attributes], [
069668c4 69 Bar->meta->get_attribute('attr'),
0eaf53c2 70], "correct get_all_attributes");
069668c4 71