t/01-basic.t

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