Commit | Line | Data |
461d2917 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
5d492ebf |
6 | use Test::More; |
461d2917 |
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 => 22; |
15 | |
461d2917 |
16 | use_ok('Moose::Policy'); |
17 | } |
18 | |
19 | { |
20 | package My::Moose::Meta::Attribute; |
21 | use Moose; |
22 | |
23 | extends 'Moose::Meta::Attribute'; |
24 | |
25 | # this one gives you PBP accessors |
26 | # and gives you accessors unless you said otherwise |
27 | sub _process_options { |
28 | my ($class, $name, $options) = @_; |
29 | my $is = delete $options->{is} || 'rw'; |
30 | if($is eq 'ro') { |
31 | $options->{reader} = 'get_' . $name; |
32 | } |
33 | elsif($is eq 'rw') { |
34 | $options->{reader} = 'get_' . $name; |
35 | $options->{writer} = 'set_' . $name; |
36 | } |
37 | elsif($is eq 'no') { |
38 | # only way to not get accessors |
39 | } |
40 | else { |
41 | # pass it through and let him deal with it |
42 | $options->{is} = $is; |
43 | } |
44 | |
45 | $class->SUPER::_process_options($name, $options); |
46 | } |
47 | } |
48 | |
49 | { |
50 | package My::Moose::Policy; |
51 | # policy just specifies metaclass delegates |
52 | use constant attribute_metaclass => 'My::Moose::Meta::Attribute'; |
53 | } |
54 | |
55 | my $oops; |
56 | { |
57 | package Foo; |
58 | |
59 | use Moose::Policy 'My::Moose::Policy'; |
60 | use Moose; |
61 | |
62 | has 'bar' => (default => 'Foo::bar'); |
63 | has 'baz' => (default => 'Foo::baz'); |
82a71d18 |
64 | has 'bop' => (is => 'bare', default => 'woot'); |
461d2917 |
65 | eval { has 'oops' => (is => 'thbbbt'); }; |
66 | $oops = $@; |
67 | } |
68 | |
69 | ok($oops, "thbbt got booted out"); |
70 | |
71 | isa_ok(Foo->meta, 'Moose::Meta::Class'); |
72 | is(Foo->meta->attribute_metaclass, 'My::Moose::Meta::Attribute', '... got our custom attr metaclass'); |
73 | |
74 | isa_ok(Foo->meta->get_attribute('bar'), 'My::Moose::Meta::Attribute'); |
75 | |
76 | my $foo = Foo->new; |
77 | isa_ok($foo, 'Foo'); |
78 | |
79 | can_ok($foo, 'get_bar'); |
80 | can_ok($foo, 'set_bar'); |
81 | |
82 | can_ok($foo, 'get_baz'); |
83 | can_ok($foo, 'set_baz'); |
84 | |
85 | ok(! $foo->can('bop'), 'do not want any bop'); |
86 | ok(! $foo->can('get_bop'), 'do not want any bop'); |
87 | ok(! $foo->can('set_bop'), 'do not want any bop'); |
88 | |
89 | ok(! $foo->can('oops'), 'do not want any oops'); |
90 | ok(! $foo->can('get_oops'), 'do not want any oops'); |
91 | ok(! $foo->can('set_oops'), 'do not want any oops'); |
92 | |
93 | is($foo->get_bar, 'Foo::bar', '... got the right default bar value'); |
94 | is($foo->get_baz, 'Foo::baz', '... got the right default baz value'); |
95 | ok(exists($foo->{bop}), 'we have bop'); |
96 | ok(! exists($foo->{oops}), 'do not want to have an oops'); |
97 | is($foo->{bop}, 'woot', '... got the right default bop value'); |
98 | |
99 | $foo->set_bar('the new bar'); |
100 | is($foo->get_bar, 'the new bar', 'setter works'); |
101 | |
102 | # vim:ts=4:sw=4:et:sta |
103 | |