Add another MOOSE_TEST_MD option, MooseX
[gitmo/Moose.git] / t / roles / runtime_roles_and_attrs.t
CommitLineData
c3b35392 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
a28e50e4 6use Test::More;
b10dde3a 7use Test::Fatal;
c3b35392 8use Scalar::Util 'blessed';
9
7ff56534 10
c3b35392 11{
12 package Dog;
13 use Moose::Role;
14
15 sub talk { 'woof' }
16
519e8a1f 17 has fur => (
18 isa => "Str",
19 is => "rw",
20 default => "dirty",
21 );
22
c3b35392 23 package Foo;
24 use Moose;
25
26 has 'dog' => (
27 is => 'rw',
28 does => 'Dog',
29 );
30}
31
32my $obj = Foo->new;
d03bd989 33isa_ok($obj, 'Foo');
c3b35392 34
35ok(!$obj->can( 'talk' ), "... the role is not composed yet");
519e8a1f 36ok(!$obj->can( 'fur' ), 'ditto');
c3b35392 37ok(!$obj->does('Dog'), '... we do not do any roles yet');
38
b10dde3a 39isnt( exception {
c3b35392 40 $obj->dog($obj)
b10dde3a 41}, undef, '... and setting the accessor fails (not a Dog yet)' );
c3b35392 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");
519e8a1f 47ok($obj->can('fur'), "it has fur");
c3b35392 48
49is($obj->talk, 'woof', '... got the right return value for the newly composed method');
50
b10dde3a 51is( exception {
c3b35392 52 $obj->dog($obj)
b10dde3a 53}, undef, '... and setting the accessor is okay' );
c3b35392 54
519e8a1f 55is($obj->fur, "dirty", "role attr initialized");
a28e50e4 56
57done_testing;