Make sure this length parameter is r/o
[gitmo/MooseX-Role-Parameterized.git] / t / 004-with.t
CommitLineData
d55c8861 1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Test::More tests => 6;
5
6do {
7 package MyItem::Role::Wearable;
8 use Moose::Role;
9
10 has is_worn => (
11 is => 'rw',
12 isa => 'Bool',
13 default => 0,
14 );
15
16 sub equip { shift->is_worn(1) }
17 sub remove { shift->is_worn(0) }
18};
19
20do {
21 package MyItem::Role::Equippable;
22 use MooseX::Role::Parameterized;
23
24 parameter slot => (
25 is => 'ro',
26 isa => 'Str',
27 required => 1,
28 );
29
30 role {
31 my $p = shift;
32
33 with 'MyItem::Role::Wearable';
34
35 method slot => sub { $p->slot };
36 };
37};
38
39do {
40 package MyItem::Helmet;
41 use Moose;
42 with 'MyItem::Role::Equippable' => {
43 slot => 'head',
44 };
45};
46
47do {
48 package MyItem::Belt;
49 use Moose;
50 with 'MyItem::Role::Equippable' => {
51 slot => 'waist',
52 };
53};
54
55can_ok('MyItem::Helmet', qw/is_worn equip remove slot/);
56can_ok('MyItem::Belt', qw/is_worn equip remove slot/);
57
58my $visored = MyItem::Helmet->new(is_worn => 1);
59ok($visored->is_worn);
60is($visored->slot, 'head');
61
62my $utility = MyItem::Belt->new;
63ok(!$utility->is_worn);
64is($utility->slot, 'waist');
65