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