use compiled type constraints. this change makes faster :)
[gitmo/Mouse.git] / t / 019-handles.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 24;
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
40     TODO: {
41         local our $TODO = "Mouse lacks this";
42         eval {
43             has error => (
44                 handles => "string",
45             );
46         };
47         ::ok(!$@, "handles => role");
48     }
49
50     TODO: {
51         local our $TODO = "Mouse lacks this";
52         eval {
53             has error2 => (
54                 handles => \"ref_to_string",
55             );
56         };
57         ::ok(!$@, "handles => \\str");
58     }
59
60     TODO: {
61         local our $TODO = "Mouse lacks this";
62         eval {
63             has error3 => (
64                 handles => qr/regex/,
65             );
66         };
67         ::ok(!$@, "handles => qr/re/");
68     }
69
70     TODO: {
71         local our $TODO = "Mouse lacks this";
72         eval {
73             has error4 => (
74                 handles => sub { "code" },
75             );
76         };
77         ::ok(!$@, "handles => sub { code }");
78     }
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,
110     [ 'name', 'age' ],
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