Add a comment
[gitmo/Mouse.git] / t / 007-attributes.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 15;
5 use Test::Exception;
6
7 do {
8     package Class;
9     use Mouse;
10
11     has 'x' => (
12         is => 'bare',
13     );
14
15     has 'y' => (
16         is => 'ro',
17     );
18
19     has 'z' => (
20         is => 'rw',
21     );
22
23     has 'attr' => (
24         accessor => 'rw_attr',
25         reader   => 'read_attr',
26         writer   => 'write_attr',
27     );
28 };
29
30 ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
31 can_ok('Class', 'y', 'z');
32
33 my $object = Class->new;
34
35 ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
36 can_ok($object, 'y', 'z');
37
38 is($object->y, undef);
39
40 throws_ok {
41     $object->y(10);
42 } qr/Cannot assign a value to a read-only accessor/;
43
44 is($object->y, undef);
45
46 is($object->z, undef);
47 is($object->z(10), 10);
48 is($object->z, 10);
49
50 can_ok($object, qw(rw_attr read_attr write_attr));
51 $object->write_attr(42);
52 is $object->rw_attr, 42;
53 is $object->read_attr, 42;
54 $object->rw_attr(100);
55 is $object->rw_attr, 100;
56 is $object->read_attr, 100;
57