t/04-parameterized-roles.t

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use Test::Fatal;
   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 => 12;
  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     is( exception {
  57         $instance->foo('bar');
  58         is $instance->foo, 3;
  59     }, undef, 'attribute coercion ran' );
  60
  61     is( exception {
  62         $instance->bar('baz');
  63         is $instance->bar, 3;
  64     }, undef, 'class attribute coercion ran' );
  65
  66     isnt( exception { $instance->baz('quux') }, undef, 'class attribute coercion did not run with coerce => 0' );
  67
  68     isnt( exception { $instance->quux('mtfnpy') }, undef, 'attribute coercion did not run with coerce => 0' );
  69
  70     is( exception {
  71         $instance->uncoerced_attr(10);
  72         is $instance->uncoerced_attr(10), 10;
  73     }, undef, 'set attribute having type with no coercion and no coerce=0' );
  74
  75     is( exception {
  76         $instance->uncoerced_class_attr(10);
  77         is $instance->uncoerced_class_attr(10), 10;
  78     }, undef, 'set class attribute having type with no coercion and no coerce=0' );
  79
  80     is( exception {
  81         $instance->untyped_attr(10);
  82         is $instance->untyped_attr, 10;
  83     }, undef, 'set untyped attribute' );
  84
  85     is( exception {
  86         $instance->untyped_class_attr(10);
  87         is $instance->untyped_class_attr, 10;
  88     }, undef, 'set untyped class attribute' );
  89 }