#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 27;
+use Test::More tests => 26;
use Test::Exception;
do {
sub name { $_[0]->{name} = $_[1] if @_ > 1; $_[0]->{name} }
sub age { $_[0]->{age} = $_[1] if @_ > 1; $_[0]->{age} }
+ sub make_string {
+ my($self, $template) = @_;
+ return sprintf $template, $self->name;
+ }
+
package Class;
use Mouse;
handles => {
person_name => 'name',
person_age => 'age',
+ person_hello => [make_string => 'Hello, %s'],
},
);
predicate => 'quid',
handles => [qw/name age/],
);
-
- TODO: {
- local our $TODO = "Mouse lacks this";
- eval {
- has error => (
- handles => "string",
- );
- };
- ::ok(!$@, "handles => role");
- }
-
- TODO: {
- local our $TODO = "Mouse lacks this";
- eval {
- has error2 => (
- handles => \"ref_to_string",
- );
- };
- ::ok(!$@, "handles => \\str");
- }
-
- TODO: {
- local our $TODO = "Mouse lacks this";
- eval {
- has error4 => (
- handles => sub { "code" },
- );
- };
- ::ok(!$@, "handles => sub { code }");
- }
};
can_ok(Class => qw(person has_person person_name person_age name age quid));
is($object->person->name, "Todd", "traditional lookup");
is($object->person_age, 37, "handles method");
is($object->person->age, 37, "traditional lookup");
+is($object->person_hello, 'Hello, Todd', 'curring');
my $object2 = Class->new(person => Person->new(name => "Philbert"));
ok($object2->has_person, "we have a person from the constructor");
is($object2->person->name, "Philbert", "traditional lookup");
is($object2->person_age, undef, "no age because we didn't use the default");
is($object2->person->age, undef, "no age because we didn't use the default");
-
+is($object2->person_hello, 'Hello, Philbert', 'currying');
ok($object->quid, "we have a Shawn");
is($object->name, "Shawn", "name handle");
is_deeply(
$object->meta->get_attribute('person')->handles,
- { person_name => 'name', person_age => 'age' },
+ { person_name => 'name', person_age => 'age', person_hello => [make_string => 'Hello, %s']},
"correct handles layout for 'person'",
);
{
- local $TODO = "failed on some environment, but I don't know why it happens (gfx)";
throws_ok{
$object->person(undef);
$object->person_name();