1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
use strict;
use warnings;
use Test::More;
use Test::Fatal;
{
package TestClientClass;
use Moo;
use namespace::clean -except => 'meta';
sub consume {}
}
{
package TestBadClientClass;
use Moo;
use namespace::clean -except => 'meta';
sub not_consume {}
}
{
package TestRole;
use Moo::Role;
use Sub::Quote;
use namespace::clean -except => 'meta';
has output_to => (
isa => quote_sub(q{
use Scalar::Util ();
die $_[0] . "Does not have a ->consume method" unless Scalar::Util::blessed($_[0]) && $_[0]->can('consume'); }),
is => 'ro',
required => 1,
coerce => quote_sub(q{
use Scalar::Util ();
if (Scalar::Util::blessed($_[0]) && $_[0]->can('consume')) {
$_[0];
} else {
my %stuff = %{$_[0]};
my $class = delete($stuff{class});
$class->new(%stuff);
}
}),
);
}
{
package TestMooClass;
use Moo;
with 'TestRole';
}
{
package TestMooseClass;
use Moose;
with 'TestRole';
}
foreach my $name (qw/ TestMooClass TestMooseClass /) {
my $i = $name->new(output_to => TestClientClass->new());
ok $i->output_to->can('consume');
$i = $name->new(output_to => { class => 'TestClientClass' });
ok $i->output_to->can('consume');
};
foreach my $name (qw/ TestMooClass TestMooseClass /) {
ok !exception { TestBadClientClass->new };
ok exception { $name->new(output_to => TestBadClientClass->new()) };
ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) };
}
done_testing;
|
