t/005-with-parameterized.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 6;
   5
   6 do {
   7     package MyItem::Role::Wearable;
   8     use MooseX::Role::Parameterized;
   9
  10     parameter is_worn_default => (
  11         is      => 'rw',
  12         isa     => 'Bool',
  13         default => 1,
  14     );
  15
  16     role {
  17         my $p = shift;
  18         has is_worn => (
  19             is      => 'rw',
  20             isa     => 'Bool',
  21             default => $p->is_worn_default,
  22         );
  23
  24         method equip => sub { shift->is_worn(1) };
  25         method remove => sub { shift->is_worn(0) };
  26     };
  27 };
  28
  29 do {
  30     package MyItem::Role::Equippable;
  31     use MooseX::Role::Parameterized;
  32
  33     parameter slot => (
  34         is       => 'ro',
  35         isa      => 'Str',
  36         required => 1,
  37     );
  38
  39     # XXX: UGH! We need some way of making this work I think..
  40     parameter is_worn_default => (
  41         is      => 'rw',
  42         isa     => 'Bool',
  43         default => 1,
  44     );
  45
  46     role {
  47         my $p = shift;
  48
  49         with 'MyItem::Role::Wearable' => {
  50             is_worn_default => $p->is_worn_default,
  51         };
  52
  53         method slot => sub { $p->slot };
  54     };
  55 };
  56
  57 do {
  58     package MyItem::Helmet;
  59     use Moose;
  60     with 'MyItem::Role::Equippable' => {
  61         slot            => 'head',
  62         is_worn_default => 0,
  63     };
  64 };
  65
  66 do {
  67     package MyItem::Belt;
  68     use Moose;
  69     with 'MyItem::Role::Equippable' => {
  70         slot            => 'waist',
  71         is_worn_default => 1,
  72     };
  73 };
  74
  75 can_ok('MyItem::Helmet', qw/is_worn equip remove slot/);
  76 can_ok('MyItem::Belt', qw/is_worn equip remove slot/);
  77
  78 my $feathered = MyItem::Helmet->new;
  79 ok(!$feathered->is_worn, "default for helmet is not worn");
  80 is($feathered->slot, 'head');
  81
  82 my $chastity = MyItem::Belt->new;
  83 ok($chastity->is_worn, "default for belt is worn");
  84 is($chastity->slot, 'waist');
  85