Commit | Line | Data |
82cfc049 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
5d492ebf |
6 | use Test::More; |
82cfc049 |
7 | |
8 | BEGIN { |
5d492ebf |
9 | require Moose; |
10 | |
11 | plan skip_all => 'Moose::Policy does not work with recent versions of Moose' |
12 | if Moose->VERSION >= 1.05; |
13 | |
14 | plan tests => 11; |
15 | |
b3cebad5 |
16 | use_ok('Moose::Policy'); |
b14c8df5 |
17 | } |
18 | |
19 | { |
20 | package My::Moose::Meta::Attribute; |
21 | use Moose; |
b3cebad5 |
22 | |
b14c8df5 |
23 | extends 'Moose::Meta::Attribute'; |
b3cebad5 |
24 | |
bfacd619 |
25 | # this method (mostly stolen from M::M::Attribute) just rebuilds the |
26 | # options so anything with 'is' gets PBP accessors |
2756232e |
27 | before '_process_options' => sub { |
b14c8df5 |
28 | my ($class, $name, $options) = @_; |
b3cebad5 |
29 | if (exists $options->{is}) { |
30 | if ($options->{is} eq 'ro') { |
31 | $options->{reader} = 'get_' . $name; |
32 | } |
33 | elsif ($options->{is} eq 'rw') { |
34 | $options->{reader} = 'get_' . $name; |
35 | $options->{writer} = 'set_' . $name; |
36 | } |
37 | delete $options->{is}; |
38 | } |
39 | |
b9238462 |
40 | $class->SUPER::_process_options($name, $options); |
41 | } |
b14c8df5 |
42 | } |
43 | |
b14c8df5 |
44 | { |
45 | package My::Moose::Policy; |
bfacd619 |
46 | # policy just specifies metaclass delegates |
5d1afb58 |
47 | use constant attribute_metaclass => 'My::Moose::Meta::Attribute'; |
48 | } |
49 | |
50 | { |
51 | package Foo; |
b3cebad5 |
52 | |
5d1afb58 |
53 | use Moose::Policy 'My::Moose::Policy'; |
54 | use Moose; |
b3cebad5 |
55 | |
c5fc6242 |
56 | has 'bar' => (is => 'rw', default => 'Foo::bar'); |
bfacd619 |
57 | has 'baz' => (is => 'ro', default => 'Foo::baz'); |
5d1afb58 |
58 | } |
59 | |
b9238462 |
60 | isa_ok(Foo->meta, 'Moose::Meta::Class'); |
61 | is(Foo->meta->attribute_metaclass, 'My::Moose::Meta::Attribute', '... got our custom attr metaclass'); |
62 | |
7efb3207 |
63 | isa_ok(Foo->meta->get_attribute('bar'), 'My::Moose::Meta::Attribute'); |
5d1afb58 |
64 | |
65 | my $foo = Foo->new; |
66 | isa_ok($foo, 'Foo'); |
67 | |
68 | can_ok($foo, 'get_bar'); |
69 | can_ok($foo, 'set_bar'); |
70 | |
bfacd619 |
71 | can_ok($foo, 'get_baz'); |
2ae39004 |
72 | ok(! $foo->can('set_baz'), 'without setter'); |
bfacd619 |
73 | |
5d1afb58 |
74 | is($foo->get_bar, 'Foo::bar', '... got the right default value'); |
bfacd619 |
75 | is($foo->get_baz, 'Foo::baz', '... got the right default value'); |
5d1afb58 |
76 | |
b3cebad5 |
77 | # vim:ts=4:sw=4:et:sta |