t/03-roles.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   6 use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
   7
   8 {
   9     package MyRole;
  10     use Moose::Role;
  11     use MooseX::AlwaysCoerce;
  12     use Moose::Util::TypeConstraints;
  13
  14     subtype 'MyType', as 'Int';
  15     coerce 'MyType', from 'Str', via { length $_ };
  16
  17     subtype 'Uncoerced', as 'Int';
  18
  19     has foo => (is => 'rw', isa => 'MyType');
  20
  21     class_has bar => (is => 'rw', isa => 'MyType');
  22
  23     class_has baz => (is => 'rw', isa => 'MyType', coerce => 0);
  24
  25     has quux => (is => 'rw', isa => 'MyType', coerce => 0);
  26
  27     has uncoerced_attr => (is => 'rw', isa => 'Uncoerced');
  28
  29     class_has uncoerced_class_attr => (is => 'rw', isa => 'Uncoerced');
  30
  31     has untyped_attr => (is => 'rw');
  32
  33     class_has untyped_class_attr => (is => 'rw');
  34 }
  35
  36 {
  37     package MyClass;
  38     use Moose;
  39     with 'MyRole';
  40 }
  41
  42 ok( (my $instance = MyClass->new), 'instance' );
  43
  44 {
  45     local $TODO = (Moose->VERSION < 1.9900 ? 'waiting on Moose changes for role support' : undef);
  46
  47     is( exception {
  48         $instance->foo('bar');
  49     }, undef, 'attribute coercion ran' );
  50     is($instance->foo, 3);
  51 }
  52
  53 is( exception {
  54     $instance->bar('baz');
  55     is $instance->bar, 3;
  56 }, undef, 'class attribute coercion ran' );
  57
  58 isnt( exception { $instance->baz('quux') }, undef, 'class attribute coercion did not run with coerce => 0' );
  59
  60 isnt( exception { $instance->quux('mtfnpy') }, undef, 'attribute coercion did not run with coerce => 0' );
  61
  62 is( exception {
  63     $instance->uncoerced_attr(10);
  64     is $instance->uncoerced_attr(10), 10;
  65 }, undef, 'set attribute having type with no coercion and no coerce=0' );
  66
  67 is( exception {
  68     $instance->uncoerced_class_attr(10);
  69     is $instance->uncoerced_class_attr(10), 10;
  70 }, undef, 'set class attribute having type with no coercion and no coerce=0' );
  71
  72 is( exception {
  73     $instance->untyped_attr(10);
  74     is $instance->untyped_attr, 10;
  75 }, undef, 'set untyped attribute' );
  76
  77 is( exception {
  78     $instance->untyped_class_attr(10);
  79     is $instance->untyped_class_attr, 10;
  80 }, undef, 'set untyped class attribute' );
  81
  82 done_testing;