t/04-parameterized-roles.t

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use Test::Exception;
   7
   8 use Test::Requires {
   9     'MooseX::Role::Parameterized' => 0.01,
  10 };
  11
  12 eval <<'EOF';
  13     package Role;
  14     use MooseX::Role::Parameterized;
  15     use MooseX::ClassAttribute;
  16     use MooseX::AlwaysCoerce;
  17     use Moose::Util::TypeConstraints;
  18
  19     role {
  20         subtype 'MyType', as 'Int';
  21         coerce 'MyType', from 'Str', via { length $_ };
  22
  23         subtype 'Uncoerced', as 'Int';
  24
  25         has foo => (is => 'rw', isa => 'MyType');
  26
  27         class_has bar => (is => 'rw', isa => 'MyType');
  28
  29         class_has baz => (is => 'rw', isa => 'MyType', coerce => 0);
  30
  31         has quux => (is => 'rw', isa => 'MyType', coerce => 0);
  32
  33         has uncoerced_attr => (is => 'rw', isa => 'Uncoerced');
  34
  35         class_has uncoerced_class_attr => (is => 'rw', isa => 'Uncoerced');
  36
  37         has untyped_attr => (is => 'rw');
  38
  39         class_has untyped_class_attr => (is => 'rw');
  40     };
  41
  42     package MyClass;
  43     use Moose;
  44     with 'Role';
  45 EOF
  46
  47
  48 plan tests => 10;
  49 eval 'use Test::NoWarnings';
  50
  51 ok( (my $instance = MyClass->new), 'instance' );
  52
  53 {
  54     local $TODO = 'waiting on Moose changes for role support, and ClassAttribute changes for paramterized role support';
  55
  56     lives_and {
  57         $instance->foo('bar');
  58         is $instance->foo, 3;
  59     } 'attribute coercion ran';
  60
  61     lives_and {
  62         $instance->bar('baz');
  63         is $instance->bar, 3;
  64     } 'class attribute coercion ran';
  65
  66     dies_ok { $instance->baz('quux') }
  67         'class attribute coercion did not run with coerce => 0';
  68
  69     dies_ok { $instance->quux('mtfnpy') }
  70         'attribute coercion did not run with coerce => 0';
  71
  72     lives_and {
  73         $instance->uncoerced_attr(10);
  74         is $instance->uncoerced_attr(10), 10;
  75     } 'set attribute having type with no coercion and no coerce=0';
  76
  77     lives_and {
  78         $instance->uncoerced_class_attr(10);
  79         is $instance->uncoerced_class_attr(10), 10;
  80     } 'set class attribute having type with no coercion and no coerce=0';
  81
  82     lives_and {
  83         $instance->untyped_attr(10);
  84         is $instance->untyped_attr, 10;
  85     } 'set untyped attribute';
  86
  87     lives_and {
  88         $instance->untyped_class_attr(10);
  89         is $instance->untyped_class_attr, 10;
  90     } 'set untyped class attribute';
  91 }