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