Commit | Line | Data |
dc032014 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More tests => 8; |
5 | |
6 | do { |
7 | package MyRole::Delegator; |
8 | use MooseX::Role::Parameterized; |
9 | |
10 | parameter handles => ( |
11 | is => 'rw', |
12 | required => 1, |
13 | ); |
14 | |
15 | role { |
16 | my $p = shift; |
17 | |
18 | has attr => ( |
19 | is => 'rw', |
20 | isa => 'MyClass::WithMethods', |
21 | handles => $p->handles, |
22 | ); |
23 | }; |
24 | }; |
25 | |
26 | do { |
27 | package MyClass::WithMethods; |
28 | |
29 | sub foo { "foo" } |
30 | sub bar { "bar" } |
31 | sub baz { "baz" } |
32 | }; |
33 | |
34 | do { |
35 | package MyArrayConsumer; |
36 | use Moose; |
37 | with 'MyRole::Delegator' => { |
38 | handles => ['foo', 'bar'], |
39 | }; |
40 | }; |
41 | |
42 | can_ok(MyArrayConsumer => 'foo', 'bar'); |
43 | cant_ok(MyArrayConsumer => 'baz'); |
44 | |
45 | do { |
46 | package MyRegexConsumer; |
47 | use Moose; |
48 | with 'MyRole::Delegator' => { |
49 | handles => qr/^ba/, |
50 | }; |
51 | }; |
52 | |
53 | can_ok(MyRegexConsumer => 'bar', 'baz'); |
54 | cant_ok(MyRegexConsumer => 'foo'); |
55 | |
56 | do { |
57 | package MyHashConsumer; |
58 | use Moose; |
59 | with 'MyRole::Delegator' => { |
60 | handles => { |
61 | my_foo => 'foo', |
62 | his_baz => 'baz', |
63 | }, |
64 | }; |
65 | }; |
66 | |
67 | can_ok(MyHashConsumer => 'my_foo', 'his_baz'); |
68 | cant_ok(MyHashConsumer => qw/foo bar baz/); |
69 | |
70 | sub cant_ok { |
71 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
72 | my $instance = shift; |
73 | for my $method (@_) { |
74 | ok(!$instance->can($method), "$instance cannot $method"); |
75 | } |
76 | } |
77 | |