Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
8ab2c6ab |
4 | use Test::More; |
eab81545 |
5 | use Test::Exception; |
73e9153a |
6 | use Test::Mouse; |
c3398f5b |
7 | |
8447b3b1 |
8 | use lib 't/lib'; |
73e9153a |
9 | use MooseCompat; |
8447b3b1 |
10 | |
c3398f5b |
11 | do { |
12 | package Class; |
13 | use Mouse; |
14 | |
74be9f76 |
15 | has 'x' => ( |
16 | is => 'bare', |
17 | ); |
c3398f5b |
18 | |
19 | has 'y' => ( |
20 | is => 'ro', |
21 | ); |
22 | |
23 | has 'z' => ( |
24 | is => 'rw', |
25 | ); |
a2096df6 |
26 | |
27 | has 'attr' => ( |
28 | accessor => 'rw_attr', |
29 | reader => 'read_attr', |
30 | writer => 'write_attr', |
31 | ); |
0464d337 |
32 | has 'attr2' => ( |
33 | is => 'rw', |
34 | accessor => 'rw_attr2', |
35 | ); |
c3398f5b |
36 | }; |
cfdb93c6 |
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 | |
0464d337 |
73 | can_ok $object, qw(rw_attr2); |
74 | ok !$object->can('attr2'), "doesn't have attr2"; |
75 | |
cfdb93c6 |
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; |
0464d337 |
88 | is join(' ', @attrs), 'x y z attr attr2', 'insertion_order'; |
cfdb93c6 |
89 | } qw(Class); |
8ab2c6ab |
90 | done_testing; |