Add failing tests

diff --git a/t/001_mouse/007-attributes.t b/t/001_mouse/007-attributes.t
index f4c60ee..e4afacb 100644 (file)
--- a/t/001_mouse/007-attributes.t
+++ b/t/001_mouse/007-attributes.t
@@ -30,54 +30,54 @@ do {
         writer   => 'write_attr',
     );
 };
-
-ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
-can_ok('Class', 'y', 'z');
-
-has_attribute_ok 'Class', 'x';
-has_attribute_ok 'Class', 'y';
-has_attribute_ok 'Class', 'z';
-
-my $object = Class->new;
-
-ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
-can_ok($object, 'y', 'z');
-
-is($object->y, undef);
-
-throws_ok {
-    $object->y(10);
-} qr/Cannot assign a value to a read-only accessor/;
-
-is($object->y, undef);
-
-is($object->z, undef);
-is($object->z(10), 10);
-is($object->z, 10);
-
-can_ok($object, qw(rw_attr read_attr write_attr));
-$object->write_attr(42);
-is $object->rw_attr, 42;
-is $object->read_attr, 42;
-$object->rw_attr(100);
-is $object->rw_attr, 100;
-is $object->read_attr, 100;
-
-is $object->write_attr("piyo"), "piyo";
-is $object->rw_attr("yopi"),    "yopi";
-
-dies_ok {
-    Class->rw_attr();
-};
-dies_ok {
-    Class->read_attr();
-};
-dies_ok {
-    Class->write_attr(42);
-};
-
-my @attrs = map { $_->name }
-    sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
-is join(' ', @attrs), 'x y z attr', 'insertion_order';
-
+with_immutable {
+    ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
+    can_ok('Class', 'y', 'z');
+
+    has_attribute_ok 'Class', 'x';
+    has_attribute_ok 'Class', 'y';
+    has_attribute_ok 'Class', 'z';
+
+    my $object = Class->new;
+
+    ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
+    can_ok($object, 'y', 'z');
+
+    is($object->y, undef);
+
+    throws_ok {
+        $object->y(10);
+    } qr/Cannot assign a value to a read-only accessor/;
+
+    is($object->y, undef);
+
+    is($object->z, undef);
+    is($object->z(10), 10);
+    is($object->z, 10);
+
+    can_ok($object, qw(rw_attr read_attr write_attr));
+    $object->write_attr(42);
+    is $object->rw_attr, 42;
+    is $object->read_attr, 42;
+    $object->rw_attr(100);
+    is $object->rw_attr, 100;
+    is $object->read_attr, 100;
+
+    is $object->write_attr("piyo"), "piyo";
+    is $object->rw_attr("yopi"),    "yopi";
+
+    dies_ok {
+        Class->rw_attr();
+    };
+    dies_ok {
+        Class->read_attr();
+    };
+    dies_ok {
+        Class->write_attr(42);
+    };
+
+    my @attrs = map { $_->name }
+        sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
+    is join(' ', @attrs), 'x y z attr', 'insertion_order';
+} qw(Class);
 done_testing;

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;