X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F001_mouse%2F007-attributes.t;h=8e89df289ec64c244dde26decbd7e5d86898bd3b;hb=HEAD;hp=925d4c4ee7ec0e97a27d3ae8753d8a21695bdda2;hpb=ce61d034787c3c5ffba15d292a0b1cd861287f0a;p=gitmo%2FMouse.git diff --git a/t/001_mouse/007-attributes.t b/t/001_mouse/007-attributes.t index 925d4c4..8e89df2 100644 --- a/t/001_mouse/007-attributes.t +++ b/t/001_mouse/007-attributes.t @@ -1,11 +1,12 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 21; +use Test::More; use Test::Exception; +use Test::Mouse; use lib 't/lib'; -use Test::Mouse; +use MooseCompat; do { package Class; @@ -28,46 +29,62 @@ do { reader => 'read_attr', writer => 'write_attr', ); + has 'attr2' => ( + is => 'rw', + accessor => 'rw_attr2', + ); }; - -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; - -dies_ok { - Class->rw_attr(); -}; -dies_ok { - Class->read_attr(); -}; -dies_ok { - Class->write_attr(42); -}; +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"; + + can_ok $object, qw(rw_attr2); + ok !$object->can('attr2'), "doesn't have attr2"; + + 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 attr2', 'insertion_order'; +} qw(Class); +done_testing;