From: Shawn M Moore Date: Tue, 25 Nov 2008 07:11:58 +0000 (+0000) Subject: Make sure with()ing another parameterized role works X-Git-Tag: 0.05~72 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=01d364b57126e300e0542446261268797557fa82;p=gitmo%2FMooseX-Role-Parameterized.git Make sure with()ing another parameterized role works --- diff --git a/t/005-with-parameterized.t b/t/005-with-parameterized.t new file mode 100644 index 0000000..415cd8f --- /dev/null +++ b/t/005-with-parameterized.t @@ -0,0 +1,85 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 6; + +do { + package MyItem::Role::Wearable; + use MooseX::Role::Parameterized; + + parameter is_worn_default => ( + is => 'rw', + isa => 'Bool', + default => 1, + ); + + role { + my $p = shift; + has is_worn => ( + is => 'rw', + isa => 'Bool', + default => $p->is_worn_default, + ); + + method equip => sub { shift->is_worn(1) }; + method remove => sub { shift->is_worn(0) }; + }; +}; + +do { + package MyItem::Role::Equippable; + use MooseX::Role::Parameterized; + + parameter slot => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + + # XXX: UGH! We need some way of making this work I think.. + parameter is_worn_default => ( + is => 'rw', + isa => 'Bool', + default => 1, + ); + + role { + my $p = shift; + + with 'MyItem::Role::Wearable' => { + is_worn_default => $p->is_worn_default, + }; + + method slot => sub { $p->slot }; + }; +}; + +do { + package MyItem::Helmet; + use Moose; + with 'MyItem::Role::Equippable' => { + slot => 'head', + is_worn_default => 0, + }; +}; + +do { + package MyItem::Belt; + use Moose; + with 'MyItem::Role::Equippable' => { + slot => 'waist', + is_worn_default => 1, + }; +}; + +can_ok('MyItem::Helmet', qw/is_worn equip remove slot/); +can_ok('MyItem::Belt', qw/is_worn equip remove slot/); + +my $feathered = MyItem::Helmet->new; +ok(!$feathered->is_worn, "default for helmet is not worn"); +is($feathered->slot, 'head'); + +my $chastity = MyItem::Belt->new; +ok($chastity->is_worn, "default for belt is worn"); +is($chastity->slot, 'waist'); +