Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
1ea948d1 |
4 | use Test::More tests => 24; |
c3398f5b |
5 | |
6 | do { |
7 | package Person; |
8 | |
9 | sub new { |
10 | my $class = shift; |
11 | my %args = @_; |
12 | |
13 | bless \%args, $class; |
14 | } |
15 | |
16 | sub name { $_[0]->{name} = $_[1] if @_ > 1; $_[0]->{name} } |
17 | sub age { $_[0]->{age} = $_[1] if @_ > 1; $_[0]->{age} } |
18 | |
19 | package Class; |
20 | use Mouse; |
21 | |
22 | has person => ( |
23 | is => 'rw', |
24 | lazy => 1, |
25 | default => sub { Person->new(age => 37, name => "Chuck") }, |
26 | predicate => 'has_person', |
27 | handles => { |
28 | person_name => 'name', |
29 | person_age => 'age', |
30 | }, |
31 | ); |
32 | |
33 | has me => ( |
34 | is => 'rw', |
35 | default => sub { Person->new(age => 21, name => "Shawn") }, |
36 | predicate => 'quid', |
37 | handles => [qw/name age/], |
38 | ); |
39 | |
6fbbcaf4 |
40 | TODO: { |
1ea948d1 |
41 | local our $TODO = "Mouse lacks this"; |
6fbbcaf4 |
42 | eval { |
43 | has error => ( |
44 | handles => "string", |
45 | ); |
46 | }; |
1ea948d1 |
47 | ::ok(!$@, "handles => role"); |
6fbbcaf4 |
48 | } |
c3398f5b |
49 | |
6fbbcaf4 |
50 | TODO: { |
1ea948d1 |
51 | local our $TODO = "Mouse lacks this"; |
6fbbcaf4 |
52 | eval { |
53 | has error2 => ( |
54 | handles => \"ref_to_string", |
55 | ); |
56 | }; |
1ea948d1 |
57 | ::ok(!$@, "handles => \\str"); |
6fbbcaf4 |
58 | } |
c3398f5b |
59 | |
6fbbcaf4 |
60 | TODO: { |
1ea948d1 |
61 | local our $TODO = "Mouse lacks this"; |
6fbbcaf4 |
62 | eval { |
63 | has error3 => ( |
64 | handles => qr/regex/, |
65 | ); |
66 | }; |
1ea948d1 |
67 | ::ok(!$@, "handles => qr/re/"); |
6fbbcaf4 |
68 | } |
c3398f5b |
69 | |
6fbbcaf4 |
70 | TODO: { |
1ea948d1 |
71 | local our $TODO = "Mouse lacks this"; |
6fbbcaf4 |
72 | eval { |
73 | has error4 => ( |
74 | handles => sub { "code" }, |
75 | ); |
76 | }; |
1ea948d1 |
77 | ::ok(!$@, "handles => sub { code }"); |
6fbbcaf4 |
78 | } |
c3398f5b |
79 | }; |
80 | |
81 | can_ok(Class => qw(person has_person person_name person_age name age quid)); |
82 | |
83 | my $object = Class->new; |
84 | ok(!$object->has_person, "don't have a person yet"); |
85 | $object->person_name("Todd"); |
86 | ok($object->has_person, "calling person_name instantiated person"); |
87 | ok($object->person, "we really do have a person"); |
88 | |
89 | is($object->person_name, "Todd", "handles method"); |
90 | is($object->person->name, "Todd", "traditional lookup"); |
91 | is($object->person_age, 37, "handles method"); |
92 | is($object->person->age, 37, "traditional lookup"); |
93 | |
94 | my $object2 = Class->new(person => Person->new(name => "Philbert")); |
95 | ok($object2->has_person, "we have a person from the constructor"); |
96 | is($object2->person_name, "Philbert", "handles method"); |
97 | is($object2->person->name, "Philbert", "traditional lookup"); |
98 | is($object2->person_age, undef, "no age because we didn't use the default"); |
99 | is($object2->person->age, undef, "no age because we didn't use the default"); |
100 | |
101 | |
102 | ok($object->quid, "we have a Shawn"); |
103 | is($object->name, "Shawn", "name handle"); |
104 | is($object->age, 21, "age handle"); |
105 | is($object->me->name, "Shawn", "me->name"); |
106 | is($object->me->age, 21, "me->age"); |
107 | |
108 | is_deeply( |
109 | $object->meta->get_attribute('me')->handles, |
c3cc3642 |
110 | [ 'name', 'age' ], |
c3398f5b |
111 | "correct handles layout for 'me'", |
112 | ); |
113 | |
114 | is_deeply( |
115 | $object->meta->get_attribute('person')->handles, |
116 | { person_name => 'name', person_age => 'age' }, |
117 | "correct handles layout for 'person'", |
118 | ); |
119 | |