DEATH TO ALL zionist ELLIPSES
[gitmo/Moose.git] / t / 030_roles / 016_runtime_roles_and_nonmoose.t
CommitLineData
a6ff1f9e 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
7ff56534 6use Test::More tests => 7;
a6ff1f9e 7use Test::Exception;
8use Scalar::Util 'blessed';
9
7ff56534 10
a6ff1f9e 11
12
13{
14 package Dog;
15 use Moose::Role;
16
17 sub talk { 'woof' }
18
19 package Foo;
20 use Moose;
21
22 has 'dog' => (
23 is => 'rw',
24 does => 'Dog',
25 );
26
27 no Moose;
28
29 package Bar;
30
31 sub new {
32 return bless {}, shift;
33 }
34}
35
238b424d 36my $bar = Bar->new;
d03bd989 37isa_ok($bar, 'Bar');
a6ff1f9e 38
39my $foo = Foo->new;
d03bd989 40isa_ok($foo, 'Foo');
a6ff1f9e 41
238b424d 42ok(!$bar->can( 'talk' ), "... the role is not composed yet");
a6ff1f9e 43
44dies_ok {
238b424d 45 $foo->dog($bar)
1808c2da 46} 'and setting the accessor fails (not a Dog yet)';
a6ff1f9e 47
238b424d 48Dog->meta->apply($bar);
a6ff1f9e 49
238b424d 50ok($bar->can('talk'), "... the role is now composed at the object level");
a6ff1f9e 51
1808c2da 52is($bar->talk, 'woof', 'got the right return value for the newly composed method');
a6ff1f9e 53
54lives_ok {
238b424d 55 $foo->dog($bar)
1808c2da 56} 'and setting the accessor is okay';
a6ff1f9e 57