X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F001_mouse%2F028-subclass-attr.t;fp=t%2F001_mouse%2F028-subclass-attr.t;h=8abd69d758df0d86ff87e9439ec264f037bb87ed;hp=9a4eabab827eed16609a55c853fe99a9c314e8bf;hb=cfdb93c63c45d0e81e858631b62a7d4d7be87842;hpb=51b0597dcccaadf7fe2a6ff3ab9bd54c39e8bf47 diff --git a/t/001_mouse/028-subclass-attr.t b/t/001_mouse/028-subclass-attr.t index 9a4eaba..8abd69d 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"); +} qw(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"); +} qw(Foo Bar); -is_deeply([Bar->meta->get_all_attributes], [ - Bar->meta->get_attribute('attr'), -], "correct get_all_attributes"); +done_testing;