updated dependents test
[gitmo/Moo.git] / t / accessor-handles.t
CommitLineData
3f343f5c 1use strictures 1;
2use Test::More;
a736c76b 3use Test::Fatal;
3f343f5c 4
baa7d706 5use lib "t/lib";
6
7{
8 package Baz;
9 use Moo;
10 sub beep {'beep'}
43a43bff 11
12 sub is_passed_undefined { !defined($_[0]) ? 'bar' : 'fail' }
baa7d706 13}
14
3f343f5c 15{
16 package Robot;
17
18 use Moo::Role;
19
20 requires 'smash';
baa7d706 21 $INC{"Robot.pm"} = 1;
3f343f5c 22
23}
24
25{
26 package Foo;
27
28 use Moo;
29
30 with 'Robot';
31
32 sub one {1}
33 sub two {2}
34 sub smash {'smash'}
35 sub yum {$_[1]}
36}
37
38{
39 package Bar;
40
41 use Moo;
42
43 has foo => ( is => 'ro', handles => [ qw(one two) ] );
44 has foo2 => ( is => 'ro', handles => { un => 'one' } );
45 has foo3 => ( is => 'ro', handles => 'Robot' );
46 has foo4 => ( is => 'ro', handles => {
47 eat_curry => [ yum => 'Curry!' ],
48 });
baa7d706 49 has foo5 => ( is => 'ro', handles => 'ExtRobot' );
43a43bff 50 has foo6 => ( is => 'rw',
51 handles => { foobot => '${\\Baz->can("beep")}'},
52 default => sub { 0 } );
53 has foo7 => ( is => 'rw',
54 handles => { foobar => '${\\Baz->can("is_passed_undefined")}'},
55 default => sub { undef } );
56
3f343f5c 57}
58
59my $bar = Bar->new(
baa7d706 60 foo => Foo->new, foo2 => Foo->new, foo3 => Foo->new, foo4 => Foo->new,
61 foo5 => Baz->new
3f343f5c 62);
63
64is $bar->one, 1, 'handles works';
65is $bar->two, 2, 'handles works for more than one method';
66
67is $bar->un, 1, 'handles works for aliasing a method';
68
69is $bar->smash, 'smash', 'handles works for a role';
70
baa7d706 71is $bar->beep, 'beep', 'handles loads roles';
72
3f343f5c 73is $bar->eat_curry, 'Curry!', 'handles works for currying';
74
43a43bff 75is $bar->foobot, 'beep', 'asserter checks for existence not truth, on false value';
76
77is $bar->foobar, 'bar', 'asserter checks for existence not truth, on undef ';
cc3310ee 78
a736c76b 79ok(my $e = exception {
80 package Baz;
81 use Moo;
82 has foo => ( is => 'ro', handles => 'Robot' );
83 sub smash { 1 };
84}, 'handles will not overwrite locally defined method');
85like $e, qr{You cannot overwrite a locally defined method \(smash\) with a delegation},
86 '... and has correct error message';
87
88ok(exception {
89 package Fuzz;
90 use Moo;
91 has foo => ( is => 'ro', handles => $bar );
92}, 'invalid handles throws exception');
cc3310ee 93
3f343f5c 94done_testing;