X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F001_mouse%2F028-subclass-attr.t;h=35430a5f63ee86c823b70d9d0238a1c0b391f990;hb=dca81269452dcc9ddd5a0db8ba06abba1f3b19b9;hp=9a4eabab827eed16609a55c853fe99a9c314e8bf;hpb=920139b3efca66d2caeeef306c97fa0da62c6b73;p=gitmo%2FMouse.git diff --git a/t/001_mouse/028-subclass-attr.t b/t/001_mouse/028-subclass-attr.t index 9a4eaba..35430a5 100644 --- a/t/001_mouse/028-subclass-attr.t +++ b/t/001_mouse/028-subclass-attr.t @@ -1,8 +1,8 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 11; - +use Test::More; +use Test::Mouse; do { package Class; use Mouse; @@ -20,16 +20,37 @@ do { is => 'rw', isa => 'Bool', ); -}; -my $obj = Child->new(class => 1, child => 1); -ok($obj->child, "local attribute set in constructor"); -ok($obj->class, "inherited attribute set in constructor"); - -is_deeply([sort(Child->meta->get_all_attributes)], [sort( - Child->meta->get_attribute('child'), - Class->meta->get_attribute('class'), -)], "correct get_all_attributes"); + package CA; + use Mouse; + extends qw(Class); + has ca => (is => 'rw'); + package CB; + use Mouse; + extends qw(Class); + has cb => (is => 'rw'); + package CC; + use Mouse; + extends qw(CB CA); + has cc => (is => 'rw'); +}; +with_immutable { + my $obj = Child->new(class => 1, child => 1); + ok($obj->child, "local attribute set in constructor"); + ok($obj->class, "inherited attribute set in constructor"); + + is_deeply([sort(Child->meta->get_all_attributes)], [sort( + Child->meta->get_attribute('child'), + Class->meta->get_attribute('class'), + )], "correct get_all_attributes"); + + is_deeply([sort(CC->meta->get_all_attributes)], [sort( + CC->meta->get_attribute('cc'), + CB->meta->get_attribute('cb'), + CA->meta->get_attribute('ca'), + Class->meta->get_attribute('class'), + )], "correct get_all_attributes"); +} 'Class', 'CA', 'CB', 'CC'; do { package Foo; @@ -49,23 +70,27 @@ do { ); }; -my $foo = Foo->new; -is($foo->attr, 'Foo', 'subclass does not affect parent attr'); +with_immutable { + my $foo = Foo->new; + is($foo->attr, 'Foo', 'subclass does not affect parent attr'); + + my $bar = Bar->new; + is($bar->attr, undef, 'new attribute does not have the new default'); -my $bar = Bar->new; -is($bar->attr, undef, 'new attribute does not have the new default'); + is(Foo->meta->get_attribute('attr')->default, 'Foo'); + is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro'); -is(Foo->meta->get_attribute('attr')->default, 'Foo'); -is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro'); + is(Bar->meta->get_attribute('attr')->default, undef); + is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw'); -is(Bar->meta->get_attribute('attr')->default, undef); -is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw'); + is_deeply([Foo->meta->get_all_attributes], [ + Foo->meta->get_attribute('attr'), + ], "correct get_all_attributes"); -is_deeply([Foo->meta->get_all_attributes], [ - Foo->meta->get_attribute('attr'), -], "correct get_all_attributes"); + is_deeply([Bar->meta->get_all_attributes], [ + Bar->meta->get_attribute('attr'), + ], "correct get_all_attributes"); +} 'Foo', 'Bar'; -is_deeply([Bar->meta->get_all_attributes], [ - Bar->meta->get_attribute('attr'), -], "correct get_all_attributes"); +done_testing;