Add failing tests

[gitmo/Mouse.git] / t / 001_mouse / 028-subclass-attr.t

diff --git a/t/001_mouse/028-subclass-attr.t b/t/001_mouse/028-subclass-attr.t
index 9a4eaba..8abd69d 100644 (file)
--- 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;