4 use Test::More tests => 28;
17 sub name { $_[0]->{name} = $_[1] if @_ > 1; $_[0]->{name} }
18 sub age { $_[0]->{age} = $_[1] if @_ > 1; $_[0]->{age} }
26 default => sub { Person->new(age => 37, name => "Chuck") },
27 predicate => 'has_person',
29 person_name => 'name',
36 default => sub { Person->new(age => 21, name => "Shawn") },
38 handles => [qw/name age/],
42 local our $TODO = "Mouse lacks this";
48 ::ok(!$@, "handles => role");
52 local our $TODO = "Mouse lacks this";
55 handles => \"ref_to_string",
58 ::ok(!$@, "handles => \\str");
62 local our $TODO = "Mouse lacks this";
68 ::ok(!$@, "handles => qr/re/");
72 local our $TODO = "Mouse lacks this";
75 handles => sub { "code" },
78 ::ok(!$@, "handles => sub { code }");
82 can_ok(Class => qw(person has_person person_name person_age name age quid));
84 my $object = Class->new;
85 ok(!$object->has_person, "don't have a person yet");
86 $object->person_name("Todd");
87 ok($object->has_person, "calling person_name instantiated person");
88 ok($object->person, "we really do have a person");
90 is($object->person_name, "Todd", "handles method");
91 is($object->person->name, "Todd", "traditional lookup");
92 is($object->person_age, 37, "handles method");
93 is($object->person->age, 37, "traditional lookup");
95 my $object2 = Class->new(person => Person->new(name => "Philbert"));
96 ok($object2->has_person, "we have a person from the constructor");
97 is($object2->person_name, "Philbert", "handles method");
98 is($object2->person->name, "Philbert", "traditional lookup");
99 is($object2->person_age, undef, "no age because we didn't use the default");
100 is($object2->person->age, undef, "no age because we didn't use the default");
103 ok($object->quid, "we have a Shawn");
104 is($object->name, "Shawn", "name handle");
105 is($object->age, 21, "age handle");
106 is($object->me->name, "Shawn", "me->name");
107 is($object->me->age, 21, "me->age");
110 $object->meta->get_attribute('me')->handles,
112 "correct handles layout for 'me'",
116 $object->meta->get_attribute('person')->handles,
117 { person_name => 'name', person_age => 'age' },
118 "correct handles layout for 'person'",
123 local $TODO = "failed on some environment, but I don't know why it happens (gfx)";
125 $object->person(undef);
126 $object->person_name();
127 } qr/Cannot delegate person_name to name because the value of person is not defined/;
131 $object->person_age();
132 } qr/Cannot delegate person_age to age because the value of person is not an object/;
136 $object->person(undef);
137 $object->person_name();
139 like $@, qr/Cannot delegate person_name to name because the value of person is not defined/;
143 $object->person_age();
145 like $@, qr/Cannot delegate person_age to age because the value of person is not an object/;