Remove some todos in tests
[gitmo/Mouse.git] / t / 001_mouse / 019-handles.t
CommitLineData
c3398f5b 1#!/usr/bin/env perl
2use strict;
3use warnings;
3aa1e09a 4use Test::More tests => 24;
7b133c92 5use Test::Exception;
c3398f5b 6
7do {
8 package Person;
9
10 sub new {
11 my $class = shift;
12 my %args = @_;
13
14 bless \%args, $class;
15 }
16
17 sub name { $_[0]->{name} = $_[1] if @_ > 1; $_[0]->{name} }
18 sub age { $_[0]->{age} = $_[1] if @_ > 1; $_[0]->{age} }
19
20 package Class;
21 use Mouse;
22
23 has person => (
24 is => 'rw',
25 lazy => 1,
26 default => sub { Person->new(age => 37, name => "Chuck") },
27 predicate => 'has_person',
28 handles => {
29 person_name => 'name',
30 person_age => 'age',
31 },
32 );
33
34 has me => (
35 is => 'rw',
36 default => sub { Person->new(age => 21, name => "Shawn") },
37 predicate => 'quid',
38 handles => [qw/name age/],
39 );
c3398f5b 40};
41
42can_ok(Class => qw(person has_person person_name person_age name age quid));
43
44my $object = Class->new;
45ok(!$object->has_person, "don't have a person yet");
46$object->person_name("Todd");
47ok($object->has_person, "calling person_name instantiated person");
48ok($object->person, "we really do have a person");
49
50is($object->person_name, "Todd", "handles method");
51is($object->person->name, "Todd", "traditional lookup");
52is($object->person_age, 37, "handles method");
53is($object->person->age, 37, "traditional lookup");
54
55my $object2 = Class->new(person => Person->new(name => "Philbert"));
56ok($object2->has_person, "we have a person from the constructor");
57is($object2->person_name, "Philbert", "handles method");
58is($object2->person->name, "Philbert", "traditional lookup");
59is($object2->person_age, undef, "no age because we didn't use the default");
60is($object2->person->age, undef, "no age because we didn't use the default");
61
62
63ok($object->quid, "we have a Shawn");
64is($object->name, "Shawn", "name handle");
65is($object->age, 21, "age handle");
66is($object->me->name, "Shawn", "me->name");
67is($object->me->age, 21, "me->age");
68
69is_deeply(
70 $object->meta->get_attribute('me')->handles,
c3cc3642 71 [ 'name', 'age' ],
c3398f5b 72 "correct handles layout for 'me'",
73);
74
75is_deeply(
76 $object->meta->get_attribute('person')->handles,
77 { person_name => 'name', person_age => 'age' },
78 "correct handles layout for 'person'",
79);
80
912fa381 81
82{
912fa381 83 throws_ok{
84 $object->person(undef);
85 $object->person_name();
86 } qr/Cannot delegate person_name to name because the value of person is not defined/;
87
88 throws_ok{
89 $object->person([]);
90 $object->person_age();
91 } qr/Cannot delegate person_age to age because the value of person is not an object/;
92}
93
94eval{
7b133c92 95 $object->person(undef);
96 $object->person_name();
912fa381 97};
98like $@, qr/Cannot delegate person_name to name because the value of person is not defined/;
7b133c92 99
912fa381 100eval{
7b133c92 101 $object->person([]);
102 $object->person_age();
912fa381 103};
104like $@, qr/Cannot delegate person_age to age because the value of person is not an object/;
105
7b133c92 106