t/01-basic.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 16;
   5 use Test::Fatal;
   6 use Test::NoWarnings 1.04 ':early';
   7
   8 {
   9     package MyClass;
  10     use Moose;
  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 ok( (my $instance = MyClass->new), 'instance' );
  37
  38 is(
  39     exception {
  40         $instance->foo('bar');
  41         is $instance->foo, 3;
  42     },
  43     undef,
  44     'attribute coercion ran',
  45 );
  46
  47 is(
  48     exception {
  49         $instance->bar('baz');
  50         is $instance->bar, 3;
  51     },
  52     undef,
  53     'class attribute coercion ran',
  54 );
  55
  56 isnt(
  57     exception { $instance->baz('quux') },
  58     undef,
  59     'class attribute coercion did not run with coerce => 0',
  60 );
  61
  62 isnt(
  63     exception{ $instance->quux('mtfnpy') },
  64     undef,
  65     'attribute coercion did not run with coerce => 0',
  66 );
  67
  68 is(
  69     exception {
  70         $instance->uncoerced_attr(10);
  71         is $instance->uncoerced_attr(10), 10;
  72     },
  73     undef,
  74     'set attribute having type with no coercion and no coerce=0',
  75 );
  76
  77 is(
  78     exception {
  79         $instance->uncoerced_class_attr(10);
  80         is $instance->uncoerced_class_attr(10), 10;
  81     },
  82     undef,
  83     'set class attribute having type with no coercion and no coerce=0',
  84 );
  85
  86 is(
  87     exception {
  88         $instance->untyped_attr(10);
  89         is $instance->untyped_attr, 10;
  90     },
  91     undef,
  92     'set untyped attribute',
  93 );
  94
  95 is(
  96     exception {
  97         $instance->untyped_class_attr(10);
  98         is $instance->untyped_class_attr, 10;
  99     },
 100     undef,
 101     'set untyped class attribute',
 102 );