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