Workaround a Test::Builder2 (2.00_06)'s threading issue.
[gitmo/Mouse.git] / t / 001_mouse / 007-attributes.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More;
5 use Test::Exception;
6 use Test::Mouse;
7
8 use lib 't/lib';
9 use MooseCompat;
10
11 do {
12     package Class;
13     use Mouse;
14
15     has 'x' => (
16         is => 'bare',
17     );
18
19     has 'y' => (
20         is => 'ro',
21     );
22
23     has 'z' => (
24         is => 'rw',
25     );
26
27     has 'attr' => (
28         accessor => 'rw_attr',
29         reader   => 'read_attr',
30         writer   => 'write_attr',
31     );
32     has 'attr2' => (
33         is       => 'rw',
34         accessor => 'rw_attr2',
35     );
36 };
37 with_immutable {
38     ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
39     can_ok('Class', 'y', 'z');
40
41     has_attribute_ok 'Class', 'x';
42     has_attribute_ok 'Class', 'y';
43     has_attribute_ok 'Class', 'z';
44
45     my $object = Class->new;
46
47     ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
48     can_ok($object, 'y', 'z');
49
50     is($object->y, undef);
51
52     throws_ok {
53         $object->y(10);
54     } qr/Cannot assign a value to a read-only accessor/;
55
56     is($object->y, undef);
57
58     is($object->z, undef);
59     is($object->z(10), 10);
60     is($object->z, 10);
61
62     can_ok($object, qw(rw_attr read_attr write_attr));
63     $object->write_attr(42);
64     is $object->rw_attr, 42;
65     is $object->read_attr, 42;
66     $object->rw_attr(100);
67     is $object->rw_attr, 100;
68     is $object->read_attr, 100;
69
70     is $object->write_attr("piyo"), "piyo";
71     is $object->rw_attr("yopi"),    "yopi";
72
73     can_ok $object, qw(rw_attr2);
74     ok !$object->can('attr2'), "doesn't have attr2";
75
76     dies_ok {
77         Class->rw_attr();
78     };
79     dies_ok {
80         Class->read_attr();
81     };
82     dies_ok {
83         Class->write_attr(42);
84     };
85
86     my @attrs = map { $_->name }
87         sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
88     is join(' ', @attrs), 'x y z attr attr2', 'insertion_order';
89 } qw(Class);
90 done_testing;